bug#8571: misc/tty-eof SKIP reason

[Jim Meyering]

Jim Meyering wrote:

> Bruno Haible wrote:
>> building coreutils 8.12 on a Linux 2.6.25.20, glibc 2.8 machine, "make check"
>> shows this line:
>>
>>   SKIP: misc/tty-eof
>>
>> But unlike for the other tests that are skipped, there is no explanation why
>> it was skipped. I have to look into the misc/tty-eof.log file, there I find:
>>   tty-eof: this script requires Perl's Expect package >=1.11
>>
>> Could the explanation be repeated in stdout or stderr, like for the other
>> tests when they are skipped?
>
> Sure.
>
>>From 11a5a943f6c557f5cc057f073bed67829b0a05d0 Mon Sep 17 00:00:00 2001
> From: Jim Meyering <address@hidden>
> Date: Thu, 28 Apr 2011 11:12:01 +0200
> Subject: [PATCH] tests: tty-eof: when skipping, announce the reason to outer
>  stderr,

Actually, that was only the tip of the iceberg.
Many perl-based tests did the same thing (write only to the
log explaining why the test was being skipped).
This fixes all of them:

>From 156084826533bf149db7dfd2b9466ab116b4ca4b Mon Sep 17 00:00:00 2001
From: Jim Meyering <address@hidden>
Date: Thu, 28 Apr 2011 11:12:01 +0200
Subject: [PATCH] tests: write skip explanation from perl scripts also to
 outer stderr

* tests/CuSkip.pm (skip): New file/module/function, to help
the perl test scripts "skip" a test consistently, emitting
a diagnostic both into the log file and into the outermost
stderr stream that is more likely to be seen by a human.
* tests/check.mk (TESTS_ENVIRONMENT): Add -MCuSkip.
* tests/misc/date-next-dow: Use CuSkip::skip in place of warn+exit-77.
* tests/misc/tty-eof: Likewise.
* tests/misc/uniq: Likewise.
* tests/rm/fail-eperm: Likewise.
* tests/misc/md5sum-newline: Likewise.  Also, s/program_name/ME/.
* tests/misc/ls-misc (setuid_setup, main): Likewise.
* tests/misc/pwd-long: Likewise, and add -I"$abs_srcdir" -MCuSkip
to the $PERL invocation command.
Inspired by a request from Bruno Haible regarding misc/tty-eof:
http://debbugs.gnu.org/8570
---
 tests/CuSkip.pm           |   39 +++++++++++++++++++++++++++++++++++++++
 tests/check.mk            |    2 +-
 tests/misc/date-next-dow  |    2 +-
 tests/misc/ls-misc        |   10 +++++-----
 tests/misc/md5sum-newline |    6 +++---
 tests/misc/pwd-long       |   20 +++++++-------------
 tests/misc/tty-eof        |    4 ++--
 tests/misc/uniq           |    7 ++-----
 tests/rm/fail-eperm       |   25 +++++++++----------------
 9 files changed, 69 insertions(+), 46 deletions(-)
 create mode 100644 tests/CuSkip.pm

diff --git a/tests/CuSkip.pm b/tests/CuSkip.pm
new file mode 100644
index 0000000..6f5ec48
--- /dev/null
+++ b/tests/CuSkip.pm
@@ -0,0 +1,39 @@
+package CuSkip;
+# Skip a test: emit diag to log and to stderr, and exit 77
+
+# Copyright (C) 2011 Free Software Foundation, Inc.
+
+# This program is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+
+# You should have received a copy of the GNU General Public License
+# along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+use strict;
+use warnings;
+
+our $ME = $0 || "<???>";
+
+# Emit a diagnostic both to stderr and to $stderr_fileno_.
+# FIXME: don't hard-code that value (9), since it's already defined in 
init.cfg.
+sub skip ($)
+{
+  my ($msg) = @_;
+  my $stderr_fileno_ = 9;
+  warn $msg;
+  open FH, ">&$stderr_fileno_"
+    or warn "$ME: failed to dup stderr\n";
+  print FH $msg;
+  close FH
+    or warn "$ME: failed to close FD $stderr_fileno_\n";
+  exit 77;
+}
+
+1;
diff --git a/tests/check.mk b/tests/check.mk
index 1e3ca85..db7f067 100644
--- a/tests/check.mk
+++ b/tests/check.mk
@@ -63,7 +63,7 @@ TESTS_ENVIRONMENT =                           \
     if grep '^\#!/usr/bin/perl' "$$1" > /dev/null; then                        
\
       if $(PERL) -e 'use warnings' > /dev/null 2>&1; then              \
        grep '^\#!/usr/bin/perl -T' "$$1" > /dev/null && T_=T || T_=;   \
-        $(PERL) -w$$T_ -I$(srcdir) -MCoreutils                         \
+        $(PERL) -w$$T_ -I$(srcdir) -MCoreutils -MCuSkip                        
\
              -M"CuTmpdir qw($$f)" -- "$$1";    \
       else                                     \
        echo 1>&2 "$$tst: configure did not find a usable version of Perl," \
diff --git a/tests/misc/date-next-dow b/tests/misc/date-next-dow
index e61d405..fda213b 100755
--- a/tests/misc/date-next-dow
+++ b/tests/misc/date-next-dow
@@ -73,6 +73,6 @@ my $fail = run_tests ($ME, $prog, address@hidden, 
$save_temps, $verbose);
 # Skip the test if the starting and stopping day numbers differ.
 my @d_post = localtime (time);
 $d_post[7] == $d[7]
-  or (warn "$ME: test straddled a day boundary; skipped"), exit 77;
+  or CuSkip::skip "$ME: test straddled a day boundary; skipped";

 exit $fail;
diff --git a/tests/misc/ls-misc b/tests/misc/ls-misc
index 7c3bc78..8b356d4 100755
--- a/tests/misc/ls-misc
+++ b/tests/misc/ls-misc
@@ -17,7 +17,7 @@

 use strict;

-(my $program_name = $0) =~ s|.*/||;
+(my $ME = $0) =~ s|.*/||;
 my $prog = 'ls';

 # Turn off localization of executable's output.
@@ -61,8 +61,8 @@ sub setuid_setup()
            mkdir sticky && chmod +t sticky  && $test -k sticky &&
            mkdir owt    && chmod +t,o+w owt && $test -k owt &&
            mkdir owr    && chmod o+w owr)) == 0
-             or (warn "$program_name: cannot create setuid/setgid/sticky 
files,"
-                 . "so can't run this test\n"), exit 77;
+             or CuSkip::skip "$ME: cannot create setuid/setgid/sticky files,"
+                 . "so can't run this test\n";
 }

 sub mk_file(@)
@@ -285,7 +285,7 @@ my $save_temps = $ENV{SAVE_TEMPS};
 my $verbose = $ENV{VERBOSE};

 setuid_setup;
-my $fail = run_tests ($program_name, $prog, address@hidden, $save_temps, 
$verbose);
+my $fail = run_tests ($ME, $prog, address@hidden, $save_temps, $verbose);
 $fail
   and exit 1;

@@ -296,5 +296,5 @@ $env =~ s/\';.*//sm;
 $ENV{LS_COLORS} = $env;

 setuid_setup;
-$fail = run_tests ($program_name, $prog, address@hidden, $save_temps, 
$verbose);
+$fail = run_tests ($ME, $prog, address@hidden, $save_temps, $verbose);
 exit $fail;
diff --git a/tests/misc/md5sum-newline b/tests/misc/md5sum-newline
index 3b6d2f4..efd9fd3 100755
--- a/tests/misc/md5sum-newline
+++ b/tests/misc/md5sum-newline
@@ -18,7 +18,7 @@

 use strict;

-(my $program_name = $0) =~ s|.*/||;
+(my $ME = $0) =~ s|.*/||;

 # Turn off localization of executable's output.
 @ENV{qw(LANGUAGE LANG LC_ALL)} = ('C') x 3;
@@ -26,7 +26,7 @@ use strict;
 # See if we can create a file name that contains a newline.
 # Use system, since Perl doesn't let you do this with "open".
 system ('touch', "a\nb") == 0
-  or (warn "$0: failed to create newline-containing file name\n"), exit 77;
+  or CuSkip::skip "$ME: failed to create newline-containing file name\n";

 my $degenerate = "d41d8cd98f00b204e9800998ecf8427e";
 my $t = '--text';
@@ -40,5 +40,5 @@ my $save_temps = $ENV{DEBUG};
 my $verbose = $ENV{VERBOSE};

 my $prog = 'md5sum';
-my $fail = run_tests ($program_name, $prog, address@hidden, $save_temps, 
$verbose);
+my $fail = run_tests ($ME, $prog, address@hidden, $save_temps, $verbose);
 exit $fail;
diff --git a/tests/misc/pwd-long b/tests/misc/pwd-long
index 7fa95ab..3a5147d 100755
--- a/tests/misc/pwd-long
+++ b/tests/misc/pwd-long
@@ -30,7 +30,7 @@ export ARGV_0

 # Don't use CuTmpdir here, since File::Temp's use of rmtree can't
 # remove the deep tree we create.
-$PERL -Tw -- - <<\EOF
+$PERL -Tw -I"$abs_srcdir" -MCuSkip -- - <<\EOF

 # Show that pwd works even when the length of the resulting
 # directory name is longer than PATH_MAX.
@@ -77,12 +77,9 @@ substr ($expected, 0, 1) = '';
 my $i = 0;
 do
   {
-    if (!mkdir $z, 0700)
-      {
-        warn "$ME: skipping this test; cannot create long directory name "
-          . "at depth $i: $!\n";
-        exit 77;
-      }
+    mkdir $z, 0700
+      or CuSkip::skip "$ME: skipping this test; cannot create long "
+        . "directory name at depth $i: $!\n";
     chdir $z
   }
 until (++$i == $n);
@@ -91,12 +88,9 @@ my $abs_top_builddir = $ENV{abs_top_builddir};
 $abs_top_builddir
   or die "$ME: envvar abs_top_builddir not defined\n";
 my $build_src_dir = "$abs_top_builddir/src";
-if ($build_src_dir !~ m!^([-+.:/\w]+)$!)
-  {
-    warn "$ME: skipping this test; odd build source directory name:\n"
-      . "$build_src_dir\n";
-    exit 77;
-  }
+$build_src_dir =~ m!^([-+.:/\w]+)$!
+  or CuSkip::skip "$ME: skipping this test; odd build source directory name:\n"
+    . "$build_src_dir\n";
 $build_src_dir = $1;

 my $pwd_binary = "$build_src_dir/pwd";
diff --git a/tests/misc/tty-eof b/tests/misc/tty-eof
index 14910dc..23cb4d5 100755
--- a/tests/misc/tty-eof
+++ b/tests/misc/tty-eof
@@ -25,8 +25,8 @@ use strict;
 # Some older versions of Expect.pm (e.g. 1.07) lack the log_user method,
 # so check for that, too.
 eval { require Expect; Expect->require_version('1.11') };
-$@ and (warn "$ME: this script requires Perl's Expect package >=1.11\n"),
-  exit 77;
+$@
+  and CuSkip::skip "$ME: this script requires Perl's Expect package >=1.11\n";

 {
   my $fail = 0;
diff --git a/tests/misc/uniq b/tests/misc/uniq
index 1a260e4..99aa8ed 100755
--- a/tests/misc/uniq
+++ b/tests/misc/uniq
@@ -82,11 +82,8 @@ sub add_z_variants($)

 # I've only ever triggered the problem in a non-C locale.
 my $locale = $ENV{LOCALE_FR};
-if (! defined $locale || $locale eq 'none')
-  {
-    warn "$prog: skipping this test -- no appropriate locale\n";
-    exit 77;
-  }
+! defined $locale || $locale eq 'none'
+  and CuSkip::skip "$prog: skipping this test -- no appropriate locale\n";

 # See if isblank returns true for nbsp.
 my $x = `env printf '\xa0'| LC_ALL=$locale tr '[:blank:]' x`;
diff --git a/tests/rm/fail-eperm b/tests/rm/fail-eperm
index 4bd143a..8e8fbe3 100755
--- a/tests/rm/fail-eperm
+++ b/tests/rm/fail-eperm
@@ -24,7 +24,7 @@ use strict;
 my $uid = $<;
 # skip if root
 $uid == 0
-  and (warn "$ME: can't run this test as root: skipping this test"), exit 77;
+  and CuSkip::skip "$ME: can't run this test as root: skipping this test";

 my $verbose = $ENV{VERBOSE} && $ENV{VERBOSE} eq 'yes';

@@ -45,8 +45,7 @@ my $rm = "$ENV{abs_top_builddir}/src/rm";

 # Untaint for upcoming popen.
 $rm =~ m!^(address@hidden/]+)$!
-  or (warn "$ME: unusual absolute builddir name; skipping this test\n"),
-    exit 77;
+  or CuSkip::skip "$ME: unusual absolute builddir name; skipping this test\n";
 $rm = $1;

 # Find a directory with the sticky bit set.
@@ -142,17 +141,11 @@ foreach my $dir (@dir_list)
       }
   }

-if ( ! $found_dir)
-  {
-    warn "$ME: couldn't find a directory with the sticky bit set;"
-      . " skipping this test\n";
-    exit 77;
-  }
+$found_dir
+  or CuSkip::skip "$ME: couldn't find a directory with the sticky bit set;"
+    . " skipping this test\n";

-if ( ! $found_file)
-  {
-    warn "$ME: couldn't find a file not owned by you\n"
-      . " in any of the following directories:\n  @dir_list\n"
-      . "...so, skipping this test\n";
-    exit 77;
-  }
+$found_file
+  or CuSkip::skip "$ME: couldn't find a file not owned by you\n"
+    . " in any of the following directories:\n  @dir_list\n"
+    . "...so, skipping this test\n";
--
1.7.5.421.g9d34e