Accept a new type of input specifier: IN_PIPE,
authorJim Meyering <jim@meyering.net>
Wed, 2 Nov 2005 20:35:52 +0000 (20:35 +0000)
committerJim Meyering <jim@meyering.net>
Wed, 2 Nov 2005 20:35:52 +0000 (20:35 +0000)
to indicate that the input file should be piped into the command
under test (via `cat FILE | $prog ...').

tests/Coreutils.pm

index ec941d4f438b4f862549bee78395e3fe7c394baa..6d3c4d2f2f9d6486d7941eada85a9b2825fc680c 100644 (file)
@@ -9,12 +9,13 @@ use FileHandle;
 use File::Compare qw(compare);
 
 @ISA = qw(Exporter);
-($VERSION = '$Revision: 1.2 $ ') =~ tr/[0-9].//cd;
+($VERSION = '$Revision: 1.3 $ ') =~ 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 ENV ENV_DEL);
+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);
@@ -261,6 +262,7 @@ sub run_tests ($$$$$)
       my %seen_type;
       my @env_delete;
       my $env_prefix = '';
+      my $input_pipe_cmd;
       foreach $io_spec (@$t)
        {
          if (!ref $io_spec)
@@ -363,9 +365,20 @@ sub run_tests ($$$$$)
          my $file = _process_file_spec ($program_name, $test_name, $val,
                                         $type, \@junk_files);
 
-         if ($type eq 'IN')
+         if ($type eq 'IN' || $type eq 'IN_PIPE')
            {
-             push @args, _shell_quote $file;
+             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')
            {
@@ -410,6 +423,8 @@ sub run_tests ($$$$$)
       $actual{ERR} = "$test_name.E";
       push @junk_files, $actual{OUT}, $actual{ERR};
       my @cmd = ($prog, @args, "> $actual{OUT}", "2> $actual{ERR}");
+      defined $input_pipe_cmd
+       and unshift @cmd, $input_pipe_cmd;
       my $cmd_str = $env_prefix . join (' ', @cmd);
 
       # Delete from the environment any symbols specified by syntax