Fetish.pm renamed to Coreutils.pm.

2 files changed, 1 insertions, 474 deletions

diff --git a/tests/Fetish.pm b/tests/Fetish.pm
deleted file mode 100644
index 8e4a0260d..000000000
--- a/tests/Fetish.pm
+++ /dev/null
@@ -1,473 +0,0 @@
-package Fetish;
-# This is a testing framework.
-
-# In case you're wondering about the name, it comes from the
-# names of the three packages: FIleutils, SH-utils, TExtutils.
-
-require 5.003;
-use strict;
-use vars qw($VERSION @ISA @EXPORT);
-
-use FileHandle;
-use File::Compare qw(compare);
-
-@ISA = qw(Exporter);
-($VERSION = '$Revision: 1.17 $ ') =~ tr/[0-9].//cd;
-@EXPORT = qw (run_tests);
-
-my $debug = $ENV{DEBUG};
-
-my @Types = qw (IN OUT ERR AUX CMP EXIT PRE POST OUT_SUBST ERR_SUBST);
-my %Types = map {$_ => 1} @Types;
-my %Zero_one_type = map {$_ => 1} qw (OUT ERR EXIT PRE POST OUT_SUBST ERR_SUBST);
-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)/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 output.
-#   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
-#
-# 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 ($expected, $actual);
-  if ($differ)
-    {
-      my $info = (defined $in_or_out ? "std$in_or_out " : '');
-      warn "$program_name: test $test_name: ${info}mismatch, comparing "
-	. "$actual (actual) and $expected (expected)\n";
-      # Ignore any failure, discard stderr.
-      system "diff -c $actual $expected 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/$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;
-}
-
-# 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) = @_;
-
-  # 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 12 bytes,
-      # so that we can add a two-byte suffix without exceeding
-      # the maximum of 14 imposed on some old file systems.
-      if (14 < (length $test_name) + 2)
-	{
-	  warn "$program_name: $test_name: test name is too long (> 12)\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 $t (@$t_spec)
-    {
-      my @post_compare;
-      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;
-      foreach $io_spec (@$t)
-	{
-	  if (!ref $io_spec)
-	    {
-	      push @args, $io_spec;
-	      next;
-	    }
-
-	  die "$program_name: $test_name: invalid test spec\n"
-	    if ref $io_spec ne 'HASH';
-
-	  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.
-	  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;
-	    }
-
-	  my $file = _process_file_spec ($program_name, $test_name, $val,
-					 $type, \@junk_files);
-
-	  if ($type eq 'IN')
-	    {
-	      push @args, _shell_quote $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}");
-      my $cmd_str = join ' ', @cmd;
-      warn "Running command: `$cmd_str'\n" if $debug;
-      my $rc = 0xffff & system $cmd_str;
-      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;
-	}
-
-      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 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}} if $expect->{POST};
-
-    }
-
-  # FIXME: maybe unlink files inside the big foreach loop?
-  unlink @junk_files if ! $save_temps;
-
-  return $fail;
-}
-
-## package return
-1;
diff --git a/tests/Makefile.in b/tests/Makefile.in
index a45255027..88efbaf2c 100644
--- a/tests/Makefile.in
+++ b/tests/Makefile.in
@@ -301,7 +301,7 @@ TESTS_ENVIRONMENT = \
   PATH="`pwd`/../src$(PATH_SEPARATOR)$$PATH"
 
 EXTRA_DIST = \
-  $(TESTS) .env-warn Fetish.pm Makefile.am.in README envvar-check \
+  $(TESTS) .env-warn Coreutils.pm Makefile.am.in README envvar-check \
   expensive group-names input-tty lang-default mk-script priv-check \
   rwx-to-mode sample-test setgid-check