diff options
| -rw-r--r-- | tests/CuSkip.pm | 39 | ||||
| -rw-r--r-- | tests/check.mk | 2 | ||||
| -rwxr-xr-x | tests/misc/date-next-dow | 2 | ||||
| -rwxr-xr-x | tests/misc/ls-misc | 10 | ||||
| -rwxr-xr-x | tests/misc/md5sum-newline | 6 | ||||
| -rwxr-xr-x | tests/misc/pwd-long | 20 | ||||
| -rwxr-xr-x | tests/misc/tty-eof | 4 | ||||
| -rwxr-xr-x | tests/misc/uniq | 7 | ||||
| -rwxr-xr-x | tests/rm/fail-eperm | 25 |
9 files changed, 69 insertions, 46 deletions
diff --git a/tests/CuSkip.pm b/tests/CuSkip.pm new file mode 100644 index 000000000..6f5ec4803 --- /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 1e3ca8502..db7f06773 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 e61d405ad..fda213bd6 100755 --- 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 7c3bc7894..8b356d4ae 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, \@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 3b6d2f46a..efd9fd3a1 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, \@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 7fa95abc0..3a5147d76 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 14910dcfc..23cb4d564 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 1a260e498..99aa8edfe 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 4bd143ab6..8e8fbe300 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!^([-+\@\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"; |