Subject: bug#20989: closed (Re: bug#20989: [PATCH] tests: add coreutils' perl-driven test framework)

From: [email-masked] (GNU bug Tracking System)
Date: Sat, 08 Oct 2016 21:16:02 +0000

Your bug report

#20989: [PATCH] tests: add coreutils' perl-driven test framework

which was filed against the grep package, has been closed.

The explanation is attached below, along with your original report.
If you require more details, please reply to [email-masked].

-- 
20989: http://debbugs.gnu.org/cgi/bugreport.cgi?bug=20989
GNU Bug Tracking System
Contact [email-masked] with problems

Subject: Re: bug#20989: [PATCH] tests: add coreutils' perl-driven test framework
From: Jim Meyering <[email-masked]>
To: [email-masked]
Date: Sat, 8 Oct 2016 14:15:05 -0700
List-Id: <debbugs-submit.debbugs.gnu.org>

On Sun, Jul 5, 2015 at 7:35 PM, Jim Meyering <[email-masked]> wrote:
> I want to use this framework (from coreutils) here in grep, too, so...

Done, so closing.

Subject: [PATCH] tests: add coreutils' perl-driven test framework
From: Jim Meyering <[email-masked]>
To: [email-masked]
Date: Sun, 5 Jul 2015 19:35:01 -0700
List-Id: <debbugs-submit.debbugs.gnu.org>

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 <[email-masked]>
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