Re: coreutils-5.92 - dd skip option completely broken

[Jim Meyering]

Paul Eggert <address@hidden> wrote:
> Jim Meyering <address@hidden> writes:
>
>> I'd prefer that it go in tests/dd/skip-seek, partly because
>> the name fits, and also because I want to move away from
>> bourne-shell-based tests -- at least when it's easy to do so.
>
> OK.  However, I can't easily see how to modify that file to do the
> test I want.  Here's the shell-command test I'd like to run:
>
> test "`echo abc | dd bs=1 skip=1 | cat`" = bc
>
> where the output of "dd" is a pipe.

I think you mean `input', there.

> But I don't offhand see how to do
> that in tests/dd/skip-seek.  (Sorry, my Perl is a bit rusty....)

Oh.  There was no convenient way to do that using Coreutils.pm.
The older tests/mkscript infrastructure does provide a mechanism
to take input from a pipe, but Coreutils.pm didn't.
I've just changed Coreutils.pm so that it does, and added this test:

2005-11-02  Jim Meyering  <address@hidden>

        * tests/dd/skip-seek (sk-seek4): New test, to exercise the bug
        fixed on 2005-10-31.  This test uses the new, IN_PIPE specifier.
        * tests/Coreutils.pm: Accept a new type of input specifier: IN_PIPE,
        to indicate that the input file should be piped into the command
        under test (via `cat FILE | $prog ...').

Index: tests/dd/skip-seek
===================================================================
RCS file: /fetish/cu/tests/dd/skip-seek,v
retrieving revision 1.14
retrieving revision 1.15
diff -u -p -u -r1.14 -r1.15
--- tests/dd/skip-seek  20 Apr 2005 07:54:54 -0000      1.14
+++ tests/dd/skip-seek  2 Nov 2005 20:36:36 -0000       1.15
@@ -61,6 +61,13 @@ my @Tests =
       {OUT=> "01234567  abcdefghij          "},
       {ERR=> "2+1 records in\n0+1 records out\n1 truncated record\n"},
      ],
+     [
+      # Before fileutils-5.93, this would output just "c\n".
+      'sk-seek4', qw(bs=1 skip=1 status=noxfer),
+      {IN_PIPE=> "abc\n"},
+      {OUT=> "bc\n"},
+      {ERR=> "3+0 records in\n3+0 records out\n"},
+     ],
     );
 
 my $save_temps = $ENV{DEBUG};
Index: tests/Coreutils.pm
===================================================================
RCS file: /fetish/cu/tests/Coreutils.pm,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -p -u -r1.2 -r1.3
--- tests/Coreutils.pm  13 Aug 2005 15:34:52 -0000      1.2
+++ tests/Coreutils.pm  2 Nov 2005 20:35:52 -0000       1.3
@@ -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, address@hidden);
 
-         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