I want to use this framework (from coreutils) here in grep, too, so...
From ef4091f0813f7c0465f72ace761dfceee547c1df Mon Sep 17 00:00:00 2001
From: Jim Meyering <meyer...@fb.com>
Date: Sat, 27 Jun 2015 08:43:33 -0700
Subject: [PATCH] tests: add coreutils' perl-driven test framework
* configure.ac: Set the AM_CONDITIONAL variable, HAVE_PERL.
* tests/Coreutils.pm: New file.
* tests/CuSkip.pm: New file.
* tests/CuTmpdir.pm: New file.
* tests/no-perl: New file.
* tests/Makefile.am: Set up to use .pl tests:
(TEST_EXTENSIONS, TESTSUITE_PERL, TESTSUITE_PERL_OPTIONS): Define.
(SH_LOG_COMPILER, PL_LOG_COMPILER): Define.
(EXTRA_DIST): Add the four new file names.
---
configure.ac | 7 +
tests/Coreutils.pm | 620 +++++++++++++++++++++++++++++++++++++++++++++++++++++
tests/CuSkip.pm | 39 ++++
tests/CuTmpdir.pm | 111 ++++++++++
tests/Makefile.am | 24 +++
tests/no-perl | 6 +
6 files changed, 807 insertions(+)
create mode 100644 tests/Coreutils.pm
create mode 100644 tests/CuSkip.pm
create mode 100644 tests/CuTmpdir.pm
create mode 100644 tests/no-perl
diff --git a/configure.ac b/configure.ac
index 3f6d389..0a4f09d 100644
--- a/configure.ac
+++ b/configure.ac
@@ -94,6 +94,13 @@ AC_TYPE_SIZE_T
AC_C_CONST
gl_INIT
+# The test suite needs to know if we have a working perl.
+# FIXME: this is suboptimal. Ideally, we would be able to call gl_PERL
+# with an ACTION-IF-NOT-FOUND argument ...
+cu_have_perl=yes
+case $PERL in *"/missing "*) cu_have_perl=no;; esac
+AM_CONDITIONAL([HAVE_PERL], [test $cu_have_perl = yes])
+
AC_ARG_ENABLE([gcc-warnings],
[AS_HELP_STRING([--enable-gcc-warnings],
[turn on lots of GCC warnings (for developers)])],
diff --git a/tests/Coreutils.pm b/tests/Coreutils.pm
new file mode 100644
index 0000000..bd2088f
--- /dev/null
+++ b/tests/Coreutils.pm
@@ -0,0 +1,620 @@
+package Coreutils;
+# This is a testing framework.
+
+# Copyright (C) 1998-2015 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 vars qw($VERSION @ISA @EXPORT);
+
+use FileHandle;
+use File::Compare qw(compare);
+
+@ISA = qw(Exporter);
+($VERSION = '$Revision: 1.5 $ ') =~ tr/[0-9].//cd;
+@EXPORT = qw (run_tests triple_test getlimits);
+
+my $debug = $ENV{DEBUG};
+
+my @Types = qw (IN IN_PIPE OUT ERR AUX CMP EXIT PRE POST OUT_SUBST
+ ERR_SUBST ENV ENV_DEL);
+my %Types = map {$_ => 1} @Types;
+my %Zero_one_type = map {$_ => 1}
+ qw (OUT ERR EXIT PRE POST OUT_SUBST ERR_SUBST ENV);
+my $srcdir = "$ENV{srcdir}";
+my $Global_count = 1;
+
+# When running in a DJGPP environment, make $ENV{SHELL} point to bash.
+# Otherwise, a bad shell might be used (e.g. command.com) and many
+# tests would fail.
+defined $ENV{DJDIR}
+ and $ENV{SHELL} = "$ENV{DJDIR}/bin/bash.exe";
+
+# A file spec: a scalar or a reference to a single-keyed hash
+# ================
+# 'contents' contents only (file name is derived from test name)
+# {filename => 'contents'} filename and contents
+# {filename => undef} filename only -- $(srcdir)/tests/filename must exist
+#
+# FIXME: If there is more than one input file, then you can't specify 'REDIR'.
+# PIPE is still ok.
+#
+# I/O spec: a hash ref with the following properties
+# ================
+# - one key/value pair
+# - the key must be one of these strings: IN, OUT, ERR, AUX, CMP, EXIT
+# - the value must be a file spec
+# {OUT => 'data'} put data in a temp file and compare it to stdout from cmd
+# {OUT => {'filename'=>undef}} compare contents of existing filename to
+# stdout from cmd
+# {OUT => {'filename'=>[$CTOR, $DTOR]}} $CTOR and $DTOR are references to
+# functions, each which is passed the single argument 'filename'.
+# $CTOR must create 'filename'.
+# DTOR may be omitted in which case 'sub{unlink @_[0]}' is used.
+# FIXME: implement this
+# {ERR => ...}
+# Same as for OUT, but compare with stderr, not stdout.
+# {OUT_SUBST => 's/variable_output/expected_output/'}
+# Transform actual standard output before comparing it against expected.
+# This is useful e.g. for programs like du that produce output that
+# varies a lot from system. E.g., an empty file may consume zero file
+# blocks, or more, depending on the OS and on the file system type.
+# {ERR_SUBST => 's/variable_output/expected_output/'}
+# Transform actual stderr output before comparing it against expected.
+# This is useful when verifying that we get a meaningful diagnostic.
+# For example, in rm/fail-2eperm, we have to account for three different
+# diagnostics: Operation not permitted, Not owner, and Permission denied.
+# {EXIT => N} expect exit status of cmd to be N
+# {ENV => 'VAR=val ...'}
+# Prepend 'VAR=val ...' to the command that we execute via 'system'.
+# {ENV_DEL => 'VAR'}
+# Remove VAR from the environment just before running the corresponding
+# command, and restore any value just afterwards.
+#
+# There may be many input file specs. File names from the input specs
+# are concatenated in order on the command line.
+# There may be at most one of the OUT-, ERR-, and EXIT-keyed specs.
+# If the OUT-(or ERR)-keyed hash ref is omitted, then expect no output
+# on stdout (or stderr).
+# If the EXIT-keyed one is omitted, then expect the exit status to be zero.
+
+# FIXME: Make sure that no junkfile is also listed as a
+# non-junkfile (i.e., with undef for contents)
+
+sub _shell_quote ($)
+{
+ my ($string) = @_;
+ $string =~ s/\'/\'\\\'\'/g;
+ return "'$string'";
+}
+
+sub _create_file ($$$$)
+{
+ my ($program_name, $test_name, $file_name, $data) = @_;
+ my $file;
+ if (defined $file_name)
+ {
+ $file = $file_name;
+ }
+ else
+ {
+ $file = "$test_name.$Global_count";
+ ++$Global_count;
+ }
+
+ warn "creating file '$file' with contents '$data'\n" if $debug;
+
+ # The test spec gave a string.
+ # Write it to a temp file and return tempfile name.
+ my $fh = new FileHandle "> $file";
+ die "$program_name: $file: $!\n" if ! $fh;
+ print $fh $data;
+ $fh->close || die "$program_name: $file: $!\n";
+
+ return $file;
+}
+
+sub _compare_files ($$$$$)
+{
+ my ($program_name, $test_name, $in_or_out, $actual, $expected) = @_;
+
+ my $differ = compare ($actual, $expected);
+ if ($differ)
+ {
+ my $info = (defined $in_or_out ? "std$in_or_out " : '');
+ warn "$program_name: test $test_name: ${info}mismatch, comparing "
+ . "$expected (expected) and $actual (actual)\n";
+ # Ignore any failure, discard stderr.
+ system "diff -c $expected $actual 2>/dev/null";
+ }
+
+ return $differ;
+}
+
+sub _process_file_spec ($$$$$)
+{
+ my ($program_name, $test_name, $file_spec, $type, $junk_files) = @_;
+
+ my ($file_name, $contents);
+ if (!ref $file_spec)
+ {
+ ($file_name, $contents) = (undef, $file_spec);
+ }
+ elsif (ref $file_spec eq 'HASH')
+ {
+ my $n = keys %$file_spec;
+ die "$program_name: $test_name: $type spec has $n elements --"
+ . " expected 1\n"
+ if $n != 1;
+ ($file_name, $contents) = each %$file_spec;
+
+ # This happens for the AUX hash in an io_spec like this:
+ # {CMP=> ['zy123utsrqponmlkji', {'@AUX@'=> undef}]},
+ defined $contents
+ or return $file_name;
+ }
+ else
+ {
+ die "$program_name: $test_name: invalid RHS in $type-spec\n"
+ }
+
+ my $is_junk_file = (! defined $file_name
+ || (($type eq 'IN' || $type eq 'AUX' || $type eq 'CMP')
+ && defined $contents));
+ my $file = _create_file ($program_name, $test_name,
+ $file_name, $contents);
+
+ if ($is_junk_file)
+ {
+ push @$junk_files, $file
+ }
+ else
+ {
+ # FIXME: put $srcdir in here somewhere
+ warn "$program_name: $test_name: specified file '$file' does"
+ . " not exist\n"
+ if ! -f "$srcdir/tests/$file";
+ }
+
+ return $file;
+}
+
+sub _at_replace ($$)
+{
+ my ($map, $s) = @_;
+ foreach my $eo (qw (AUX OUT ERR))
+ {
+ my $f = $map->{$eo};
+ $f
+ and $s =~ /\@$eo\@/
+ and $s =~ s/\@$eo\@/$f/g;
+ }
+ return $s;
+}
+
+sub getlimits()
+{
+ my $NV;
+ open $NV, "getlimits |" or die "Error running getlimits\n";
+ my %limits = map {split /=|\n/} <$NV>;
+ return \%limits;
+}
+
+# FIXME: cleanup on interrupt
+# FIXME: extract 'do_1_test' function
+
+# FIXME: having to include $program_name here is an expedient kludge.
+# Library code doesn't 'die'.
+sub run_tests ($$$$$)
+{
+ my ($program_name, $prog, $t_spec, $save_temps, $verbose) = @_;
+
+ # To indicate that $prog is a shell built-in, you'd make it a string 'ref'.
+ # E.g., call run_tests ($prog, \$prog, \@Tests, $save_temps, $verbose);
+ # If it's a ref, invoke it via "env":
+ my @prog = ref $prog ? (qw(env --), $$prog) : $prog;
+
+ # Warn about empty t_spec.
+ # FIXME
+
+ # Remove all temp files upon interrupt.
+ # FIXME
+
+ # Verify that test names are distinct.
+ my $bad_test_name = 0;
+ my %seen;
+ my %seen_8dot3;
+ my $t;
+ foreach $t (@$t_spec)
+ {
+ my $test_name = $t->[0];
+ if ($seen{$test_name})
+ {
+ warn "$program_name: $test_name: duplicate test name\n";
+ $bad_test_name = 1;
+ }
+ $seen{$test_name} = 1;
+
+ if (0)
+ {
+ my $t8 = lc substr $test_name, 0, 8;
+ if ($seen_8dot3{$t8})
+ {
+ warn "$program_name: 8.3 test name conflict: "
+ . "$test_name, $seen_8dot3{$t8}\n";
+ $bad_test_name = 1;
+ }
+ $seen_8dot3{$t8} = $test_name;
+ }
+
+ # The test name may be no longer than 30 bytes.
+ # Yes, this is an arbitrary limit. If it causes trouble,
+ # consider removing it.
+ my $max = 30;
+ if ($max < length $test_name)
+ {
+ warn "$program_name: $test_name: test name is too long (> $max)\n";
+ $bad_test_name = 1;
+ }
+ }
+ return 1 if $bad_test_name;
+
+ # FIXME check exit status
+ system (@prog, '--version') if $verbose;
+
+ my @junk_files;
+ my $fail = 0;
+ foreach my $tt (@$t_spec)
+ {
+ my @post_compare;
+ my @dummy = @$tt;
+ my $t = \@dummy;
+ my $test_name = shift @$t;
+ my $expect = {};
+ my ($pre, $post);
+
+ # FIXME: maybe don't reset this.
+ $Global_count = 1;
+ my @args;
+ my $io_spec;
+ my %seen_type;
+ my @env_delete;
+ my $env_prefix = '';
+ my $input_pipe_cmd;
+ foreach $io_spec (@$t)
+ {
+ if (!ref $io_spec)
+ {
+ push @args, $io_spec;
+ next;
+ }
+
+ if (ref $io_spec ne 'HASH')
+ {
+ eval 'use Data::Dumper';
+ die "$program_name: $test_name: invalid entry in test spec; "
+ . "expected HASH-ref,\nbut got this:\n"
+ . Data::Dumper->Dump ([\$io_spec], ['$io_spec']) . "\n";
+ }
+
+ my $n = keys %$io_spec;
+ die "$program_name: $test_name: spec has $n elements --"
+ . " expected 1\n"
+ if $n != 1;
+ my ($type, $val) = each %$io_spec;
+ die "$program_name: $test_name: invalid key '$type' in test spec\n"
+ if ! $Types{$type};
+
+ # Make sure there's no more than one of OUT, ERR, EXIT, etc.
+ die "$program_name: $test_name: more than one $type spec\n"
+ if $Zero_one_type{$type} and $seen_type{$type}++;
+
+ if ($type eq 'PRE' or $type eq 'POST')
+ {
+ $expect->{$type} = $val;
+ next;
+ }
+
+ if ($type eq 'CMP')
+ {
+ my $t = ref $val;
+ $t && $t eq 'ARRAY'
+ or die "$program_name: $test_name: invalid CMP spec\n";
+ @$val == 2
+ or die "$program_name: $test_name: invalid CMP list; must have"
+ . " exactly 2 elements\n";
+ my @cmp_files;
+ foreach my $e (@$val)
+ {
+ my $r = ref $e;
+ $r && $r ne 'HASH'
+ and die "$program_name: $test_name: invalid element ($r)"
+ . " in CMP list; only scalars and hash references "
+ . "are allowed\n";
+ if ($r && $r eq 'HASH')
+ {
+ my $n = keys %$e;
+ $n == 1
+ or die "$program_name: $test_name: CMP spec has $n "
+ . "elements -- expected 1\n";
+
+ # Replace any '@AUX@' in the key of %$e.
+ my ($ff, $val) = each %$e;
+ my $new_ff = _at_replace $expect, $ff;
+ if ($new_ff ne $ff)
+ {
+ $e->{$new_ff} = $val;
+ delete $e->{$ff};
+ }
+ }
+ my $cmp_file = _process_file_spec ($program_name, $test_name,
+ $e, $type, \@junk_files);
+ push @cmp_files, $cmp_file;
+ }
+ push @post_compare, [@cmp_files];
+
+ $expect->{$type} = $val;
+ next;
+ }
+
+ if ($type eq 'EXIT')
+ {
+ die "$program_name: $test_name: invalid EXIT code\n"
+ if $val !~ /^\d+$/;
+ # FIXME: make sure $data is numeric
+ $expect->{EXIT} = $val;
+ next;
+ }
+
+ if ($type =~ /^(OUT|ERR)_SUBST$/)
+ {
+ $expect->{RESULT_SUBST} ||= {};
+ $expect->{RESULT_SUBST}->{$1} = $val;
+ next;
+ }
+
+ if ($type eq 'ENV')
+ {
+ $env_prefix = "$val ";
+ next;
+ }
+
+ if ($type eq 'ENV_DEL')
+ {
+ push @env_delete, $val;
+ next;
+ }
+
+ my $file = _process_file_spec ($program_name, $test_name, $val,
+ $type, \@junk_files);
+
+ if ($type eq 'IN' || $type eq 'IN_PIPE')
+ {
+ my $quoted_file = _shell_quote $file;
+ if ($type eq 'IN_PIPE')
+ {
+ defined $input_pipe_cmd
+ and die "$program_name: $test_name: only one input"
+ . " may be specified with IN_PIPE\n";
+ $input_pipe_cmd = "cat $quoted_file |";
+ }
+ else
+ {
+ push @args, $quoted_file;
+ }
+ }
+ elsif ($type eq 'AUX' || $type eq 'OUT' || $type eq 'ERR')
+ {
+ $expect->{$type} = $file;
+ }
+ else
+ {
+ die "$program_name: $test_name: invalid type: $type\n"
+ }
+ }
+
+ # Expect an exit status of zero if it's not specified.
+ $expect->{EXIT} ||= 0;
+
+ # Allow ERR to be omitted -- in that case, expect no error output.
+ foreach my $eo (qw (OUT ERR))
+ {
+ if (!exists $expect->{$eo})
+ {
+ $expect->{$eo} = _create_file ($program_name, $test_name,
+ undef, '');
+ push @junk_files, $expect->{$eo};
+ }
+ }
+
+ # FIXME: Does it ever make sense to specify a filename *and* contents
+ # in OUT or ERR spec?
+
+ # FIXME: this is really suboptimal...
+ my @new_args;
+ foreach my $a (@args)
+ {
+ $a = _at_replace $expect, $a;
+ push @new_args, $a;
+ }
+ @args = @new_args;
+
+ warn "$test_name...\n" if $verbose;
+ &{$expect->{PRE}} if $expect->{PRE};
+ my %actual;
+ $actual{OUT} = "$test_name.O";
+ $actual{ERR} = "$test_name.E";
+ push @junk_files, $actual{OUT}, $actual{ERR};
+ my @cmd = (@prog, @args, "> $actual{OUT}", "2> $actual{ERR}");
+ $env_prefix
+ and unshift @cmd, $env_prefix;
+ defined $input_pipe_cmd
+ and unshift @cmd, $input_pipe_cmd;
+ my $cmd_str = join (' ', @cmd);
+
+ # Delete from the environment any symbols specified by syntax
+ # like this: {ENV_DEL => 'TZ'}.
+ my %pushed_env;
+ foreach my $env_sym (@env_delete)
+ {
+ my $val = delete $ENV{$env_sym};
+ defined $val
+ and $pushed_env{$env_sym} = $val;
+ }
+
+ warn "Running command: '$cmd_str'\n" if $debug;
+ my $rc = 0xffff & system $cmd_str;
+
+ # Restore any environment setting we changed via a deletion.
+ foreach my $env_sym (keys %pushed_env)
+ {
+ $ENV{$env_sym} = $pushed_env{$env_sym};
+ }
+
+ if ($rc == 0xff00)
+ {
+ warn "$program_name: test $test_name failed: command failed:\n"
+ . " '$cmd_str': $!\n";
+ $fail = 1;
+ goto cleanup;
+ }
+ $rc >>= 8 if $rc > 0x80;
+ if ($expect->{EXIT} != $rc)
+ {
+ warn "$program_name: test $test_name failed: exit status mismatch:"
+ . " expected $expect->{EXIT}, got $rc\n";
+ $fail = 1;
+ goto cleanup;
+ }
+
+ my %actual_data;
+ # Record actual stdout and stderr contents, if POST may need them.
+ if ($expect->{POST})
+ {
+ foreach my $eo (qw (OUT ERR))
+ {
+ my $out_file = $actual{$eo};
+ open IN, $out_file
+ or (warn
+ "$program_name: cannot open $out_file for reading: $!\n"),
+ $fail = 1, next;
+ $actual_data{$eo} = <IN>;
+ close IN
+ or (warn "$program_name: failed to read $out_file: $!\n"),
+ $fail = 1;
+ }
+ }
+
+ foreach my $eo (qw (OUT ERR))
+ {
+ my $subst_expr = $expect->{RESULT_SUBST}->{$eo};
+ if (defined $subst_expr)
+ {
+ my $out = $actual{$eo};
+ my $orig = "$out.orig";
+
+ # Move $out aside (to $orig), then recreate $out
+ # by transforming each line of $orig via $subst_expr.
+ rename $out, $orig
+ or (warn "$program_name: cannot rename $out to $orig: $!\n"),
+ $fail = 1, next;
+ open IN, $orig
+ or (warn "$program_name: cannot open $orig for reading: $!\n"),
+ $fail = 1, (unlink $orig), next;
+ unlink $orig
+ or (warn "$program_name: cannot unlink $orig: $!\n"),
+ $fail = 1;
+ open OUT, ">$out"
+ or (warn "$program_name: cannot open $out for writing: $!\n"),
+ $fail = 1, next;
+ while (defined (my $line = <IN>))
+ {
+ eval "\$_ = \$line; $subst_expr; \$line = \$_";
+ print OUT $line;
+ }
+ close IN;
+ close OUT
+ or (warn "$program_name: failed to write $out: $!\n"),
+ $fail = 1, next;
+ }
+
+ my $eo_lower = lc $eo;
+ _compare_files ($program_name, $test_name, $eo_lower,
+ $actual{$eo}, $expect->{$eo})
+ and $fail = 1;
+ }
+
+ foreach my $pair (@post_compare)
+ {
+ my ($expected, $actual) = @$pair;
+ _compare_files $program_name, $test_name, undef, $actual, $expected
+ and $fail = 1;
+ }
+
+ cleanup:
+ $expect->{POST}
+ and &{$expect->{POST}} ($actual_data{OUT}, $actual_data{ERR});
+
+ }
+
+ # FIXME: maybe unlink files inside the big foreach loop?
+ unlink @junk_files if ! $save_temps;
+
+ return $fail;
+}
+
+# For each test in @$TESTS, generate two additional tests,
+# one using stdin, the other using a pipe. I.e., given this one
+# ['idem-0', {IN=>''}, {OUT=>''}],
+# generate these:
+# ['idem-0.r', '<', {IN=>''}, {OUT=>''}],
+# ['idem-0.p', {IN_PIPE=>''}, {OUT=>''}],
+# Generate new tests only if there is exactly one input spec.
+# The returned list of tests contains each input test, followed
+# by zero or two derived tests.
+sub triple_test($)
+{
+ my ($tests) = @_;
+ my @new;
+ foreach my $t (@$tests)
+ {
+ push @new, $t;
+
+ my @in;
+ my @args;
+ my @list_of_hash;
+ foreach my $e (@$t)
+ {
+ !ref $e
+ and push (@args, $e), next;
+
+ ref $e && ref $e eq 'HASH'
+ or (warn "$0: $t->[0]: unexpected entry type\n"), next;
+ defined $e->{IN}
+ and (push @in, $e->{IN}), next;
+ push @list_of_hash, $e;
+ }
+ # Add variants IFF there is exactly one input file.
+ @in == 1
+ or next;
+ shift @args; # discard test name
+ push @new, ["$t->[0].r", @args, '<', {IN => $in[0]}, @list_of_hash];
+ push @new, ["$t->[0].p", @args, {IN_PIPE => $in[0]}, @list_of_hash];
+ }
+ return @new;
+}
+
+## package return
+1;
diff --git a/tests/CuSkip.pm b/tests/CuSkip.pm
new file mode 100644
index 0000000..a25688a
--- /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-2015 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/CuTmpdir.pm b/tests/CuTmpdir.pm
new file mode 100644
index 0000000..fd65556
--- /dev/null
+++ b/tests/CuTmpdir.pm
@@ -0,0 +1,111 @@
+package CuTmpdir;
+# create, then chdir into a temporary sub-directory
+
+# Copyright (C) 2007-2015 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;
+
+use File::Temp;
+use File::Find;
+
+our $ME = $0 || "<???>";
+
+my $dir;
+
+sub skip_test($)
+{
+ warn "$ME: skipping test: unsafe working directory name: '$_[0]'\n";
+ exit 77;
+}
+
+sub chmod_1
+{
+ my $name = $_;
+
+ # Skip symlinks and non-directories.
+ -l $name || !-d _
+ and return;
+
+ chmod 0700, $name;
+}
+
+sub chmod_tree
+{
+ # When tempdir fails, it croaks, which leaves $dir undefined.
+ defined $dir
+ or return;
+
+ # Perform the equivalent of find "$dir" -type d -print0|xargs -0 chmod -R 700.
+ my $options = {untaint => 1, wanted => \&chmod_1};
+ find ($options, $dir);
+}
+
+sub import {
+ my $prefix = $_[1];
+
+ $ME eq '-' && defined $prefix
+ and $ME = $prefix;
+
+ if ($prefix !~ /^\//)
+ {
+ eval 'use Cwd';
+ my $cwd = $@ ? '.' : Cwd::getcwd();
+ $prefix = "$cwd/$prefix";
+ }
+
+ # Untaint for the upcoming mkdir.
+ $prefix =~ m!^([-+\@\w./]+)$!
+ or skip_test $prefix;
+ $prefix = $1;
+
+ my $original_pid = $$;
+
+ my $on_sig_remove_tmpdir = sub {
+ my ($sig) = @_;
+ if ($$ == $original_pid and defined $dir)
+ {
+ chmod_tree;
+ # Older versions of File::Temp lack this method.
+ exists &File::Temp::cleanup
+ and &File::Temp::cleanup;
+ }
+ $SIG{$sig} = 'DEFAULT';
+ kill $sig, $$;
+ };
+
+ foreach my $sig (qw (INT TERM HUP))
+ {
+ $SIG{$sig} = $on_sig_remove_tmpdir;
+ }
+
+ $dir = File::Temp::tempdir("$prefix.tmp-XXXX", CLEANUP => 1 );
+ chdir $dir
+ or warn "$ME: failed to chdir to $dir: $!\n";
+}
+
+END {
+ # Move cwd out of the directory we're about to remove.
+ # This is required on some systems, and by some versions of File::Temp.
+ chdir '..'
+ or warn "$ME: failed to chdir to .. from $dir: $!\n";
+
+ my $saved_errno = $?;
+ chmod_tree;
+ $? = $saved_errno;
+}
+
+1;
diff --git a/tests/Makefile.am b/tests/Makefile.am
index 629d322..ccd0196 100644
--- a/tests/Makefile.am
+++ b/tests/Makefile.am
@@ -14,6 +14,26 @@
# You should have received a copy of the GNU General Public License
# along with this program. If not, see <http://www.gnu.org/licenses/>.
+TEST_EXTENSIONS = .sh .pl
+
+if HAVE_PERL
+TESTSUITE_PERL = $(PERL)
+else
+TESTSUITE_PERL = $(SHELL) $(srcdir)/no-perl
+endif
+
+# Options passed to the perl invocations running the perl test scripts.
+TESTSUITE_PERL_OPTIONS = -w -I$(srcdir) -MCoreutils -MCuSkip
+# '$f' is set by the Automake-generated test harness to the path of the
+# current test script stripped of VPATH components, and is used by the
+# CuTmpdir module to determine the name of the temporary files to be
+# used. Note that $f is a shell variable, not a make macro, so the use
+# of '$$f' below is correct, and not a typo.
+TESTSUITE_PERL_OPTIONS += -M"CuTmpdir qw($$f)"
+
+SH_LOG_COMPILER = $(SHELL)
+PL_LOG_COMPILER = $(TESTSUITE_PERL) $(TESTSUITE_PERL_OPTIONS)
+
check_PROGRAMS = get-mb-cur-max dfa-match-aux
AM_CPPFLAGS = -I$(top_builddir)/lib -I$(top_srcdir)/lib \
-I$(top_srcdir)/src
@@ -131,12 +151,16 @@ EXTRA_DIST = \
$(TESTS) \
bre.awk \
bre.tests \
+ Coreutils.pm \
+ CuSkip.pm \
+ CuTmpdir.pm \
ere.awk \
ere.tests \
init.cfg \
init.sh \
khadafy.lines \
khadafy.regexp \
+ no-perl \
spencer1.awk \
spencer1.tests \
spencer1-locale.awk
diff --git a/tests/no-perl b/tests/no-perl
new file mode 100644
index 0000000..956a826
--- /dev/null
+++ b/tests/no-perl
@@ -0,0 +1,6 @@
+#! /bin/sh
+# Perl is not available, the test should be considered skipped.
+# FD 9 should have been opened by the test suite harness, pointing
+# to the original stderr (usually, the user's terminal).
+echo "test skipped: no usable version of Perl found" >&9
+exit 77
--
2.3.7
