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

diff --git a/tests/CuSkip.pm b/tests/CuSkip.pm
new file mode 100644 (file)
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 (file)
--- 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 (executable)
--- a/tests/misc/date-next-dow
+++ b/tests/misc/date-next-dow
@@ -73,6 +73,6 @@ my $fail = run_tests ($ME, $prog, \@Tests, $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 (executable)
--- 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, \@Tests, $save_temps, $verbose);
+my $fail = run_tests ($ME, $prog, \@Tests, $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, \@Tests, $save_temps, $verbose);
+$fail = run_tests ($ME, $prog, \@Tests, $save_temps, $verbose);
 exit $fail;

diff --git a/tests/misc/md5sum-newline b/tests/misc/md5sum-newline
index 3b6d2f4..efd9fd3 100755 (executable)
--- 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, \@Tests, $save_temps, $verbose);
+my $fail = run_tests ($ME, $prog, \@Tests, $save_temps, $verbose);
 exit $fail;

diff --git a/tests/misc/pwd-long b/tests/misc/pwd-long
index 7fa95ab..3a5147d 100755 (executable)
--- 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 (executable)
--- 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 (executable)
--- 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 (executable)
--- 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!^([-+\@\w./]+)$!
-  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";