(_compare_files): New function.

(_process_file_spec): Likewise.
(_at_replace): Likewise.
(run_tests): Support new keywords, AUX and CMP and associated
syntax and semantics.

1 files changed, 147 insertions, 47 deletions

diff --git a/tests/Fetish.pm b/tests/Fetish.pm
index fa83ee6c6..9c93947bf 100644
--- a/tests/Fetish.pm
+++ b/tests/Fetish.pm
@@ -12,12 +12,12 @@ use FileHandle;
 use File::Compare qw(compare);
 
 @ISA = qw(Exporter);
-($VERSION = '$Revision: 1.8 $ ') =~ tr/[0-9].//cd;
+($VERSION = '$Revision: 1.9 $ ') =~ tr/[0-9].//cd;
 @EXPORT = qw (run_tests);
 
 my $debug = $ENV{DEBUG};
 
-my @Types = qw (IN OUT ERR EXIT PRE POST);
+my @Types = qw (IN OUT ERR AUX CMP EXIT PRE POST);
 my %Types = map {$_ => 1} @Types;
 my %Zero_one_type = map {$_ => 1} qw (OUT ERR EXIT PRE POST);
 my $srcdir = $ENV{srcdir};
@@ -35,7 +35,7 @@ my $Global_count = 1;
 # 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, EXIT
+# - 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
@@ -91,6 +91,82 @@ sub _create_file ($$$$)
   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 =~ s/\@$eo\@/$f/g;
+    }
+  return $s;
+}
+
 # FIXME: cleanup on interrupt
 # FIXME: extract `do_1_test' function
 
@@ -129,6 +205,7 @@ sub run_tests ($$$$$)
   my $fail = 0;
   foreach $t (@$t_spec)
     {
+      my @post_compare;
       my $test_name = shift @$t;
       my $expect = {};
       my ($pre, $post);
@@ -167,6 +244,48 @@ sub run_tests ($$$$$)
 	      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"
@@ -176,48 +295,20 @@ sub run_tests ($$$$$)
 	      next;
 	    }
 
-	  my $file_spec = $val;
-	  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;
-	    }
-	  else
-	    {
-	      die "$program_name: $test_name: invalid RHS in $type-spec\n"
-	    }
+	  my $file = _process_file_spec ($program_name, $test_name, $val,
+					 $type, \@junk_files);
 
-	  my $is_junk_file = (! defined $file_name
-			      || ($type eq 'IN' && defined $contents));
-	  my $file = _create_file ($program_name, $test_name,
-				   $file_name, $contents);
 	  if ($type eq 'IN')
 	    {
 	      push @args, _shell_quote $file;
 	    }
-	  else
+	  elsif ($type eq 'AUX' || $type eq 'OUT' || $type eq 'ERR')
 	    {
 	      $expect->{$type} = $file;
 	    }
-
-	  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";
+	      die "$program_name: $test_name: invalid type: $type\n"
 	    }
 	}
 
@@ -225,8 +316,7 @@ sub run_tests ($$$$$)
       $expect->{EXIT} ||= 0;
 
       # Allow ERR to be omitted -- in that case, expect no error output.
-      my $eo;
-      foreach $eo (qw (OUT ERR))
+      foreach my $eo (qw (OUT ERR))
 	{
 	  if (!exists $expect->{$eo})
 	    {
@@ -239,6 +329,15 @@ sub run_tests ($$$$$)
       # 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 %tmp;
@@ -265,20 +364,21 @@ sub run_tests ($$$$$)
 	  goto cleanup;
 	}
 
-      foreach $eo (qw (OUT ERR))
+      foreach my $eo (qw (OUT ERR))
 	{
 	  my $eo_lower = lc $eo;
-	  if (compare ($expect->{$eo}, $tmp{$eo}))
-	    {
-	      warn "$program_name: test $test_name: std$eo_lower mismatch,"
-		. " comparing $tmp{$eo} (actual)"
-		  . " and $expect->{$eo} (expected)\n";
-	      # Ignore any failure, discard stderr.
-	      system "diff -c $tmp{$eo} $expect->{$eo} 2>/dev/null";
-	      $fail = 1;
-	    }
+	  _compare_files ($program_name, $test_name, $eo_lower,
+			  $expect->{$eo}, $tmp{$eo})
+	    and $fail = 1;
 	}
 
+    foreach my $pair (@post_compare)
+      {
+	my ($a, $b) = @$pair;
+	_compare_files $program_name, $test_name, undef, $a, $b
+	  and $fail = 1;
+      }
+
     cleanup:
       &{$expect->{POST}} if $expect->{POST};