test.pl's runperl() can now optionally redirect STDIN from /dev/null
authorNicholas Clark <nick@ccl4.org>
Wed, 7 Aug 2013 10:23:57 +0000 (12:23 +0200)
committerNicholas Clark <nick@ccl4.org>
Sun, 11 Aug 2013 14:01:22 +0000 (16:01 +0200)
There is existing code to pipe fixed input to the test perl's STDIN, which
means that STDIN can be made to be an immediate end-of-file by giving an
empty string. However, it turns out that on platforms which use ksh as
/bin/sh, ksh's setup of shell pipelines differs from a traditional Bourne
shell (and bash), using one less process in total, with the result that the
test perl starts with a child process already - the process piping to its
STDIN. This unexpected child process confuses tests for wait() which are
only expecting to see return values from processes that the test script
itself started.

As the problem case is specifically for setting up STDIN to be at EOF, it's
easier to it by enhancing test.pl's runperl() to be able to redirect STDIN
from the null device than by making the tests themselves more complex.
This approach also avoids spawning a process for quite a few of the tests.
Fortuitously it seems that the string /dev/null is portable enough to work
with the command line parsing code on VMS and Win32 too.

Thanks to Zefram for helping diagnose the problem.

It turns out that this also fixes regressions on VMS, where the pipe
implementation returns the exit code of the process at the front of the
pipeline, not the end. The result is that adding a pipeline messes up any
test using OPTION FATAL to check exit status.

t/test.pl

index 3662aa6..576df92 100644 (file)
--- a/t/test.pl
+++ b/t/test.pl
@@ -554,7 +554,7 @@ USE_OK
 #   prog     => one-liner (avoid quotes)
 #   progs    => [ multi-liner (avoid quotes) ]
 #   progfile => perl script
-#   stdin    => string to feed the stdin
+#   stdin    => string to feed the stdin (or undef to redirect from /dev/null)
 #   stderr   => redirect stderr to stdout
 #   args     => [ command-line arguments to the perl program ]
 #   verbose  => print the command line
@@ -637,6 +637,28 @@ sub _create_runperl { # Create the string to qx in runperl().
            $runperl = qq{$Perl -e 'print qq(} .
                $args{stdin} . q{)' | } . $runperl;
        }
+    } elsif (exists $args{stdin}) {
+        # Using the pipe construction above can cause fun on systems which use
+        # ksh as /bin/sh, as ksh does pipes differently (with one less process)
+        # With sh, for the command line 'perl -e 'print qq()' | perl -e ...'
+        # the sh process forks two children, which use exec to start the two
+        # perl processes. The parent shell process persists for the duration of
+        # the pipeline, and the second perl process starts with no children.
+        # With ksh (and zsh), the shell saves a process by forking a child for
+        # just the first perl process, and execing itself to start the second.
+        # This means that the second perl process starts with one child which
+        # it didn't create. This causes "fun" when if the tests assume that
+        # wait (or waitpid) will only return information about processes
+        # started within the test.
+        # They also cause fun on VMS, where the pipe implementation returns
+        # the exit code of the process at the front of the pipeline, not the
+        # end. This messes up any test using OPTION FATAL.
+        # Hence it's useful to have a way to make STDIN be at eof without
+        # needing a pipeline, so that the fork tests have a sane environment
+        # without these surprises.
+
+        # /dev/null appears to be surprisingly portable.
+        $runperl = $runperl . ($is_mswin ? ' <nul' : ' </dev/null');
     }
     if (defined $args{args}) {
        $runperl = _quote_args($runperl, $args{args});
@@ -1125,7 +1147,7 @@ sub run_multiple_progs {
        print $fh $prog,"\n";
        close $fh or die "Cannot close $tmpfile: $!";
        my $results = runperl( stderr => 1, progfile => $tmpfile,
-                              stdin => '', $up
+                              stdin => undef, $up
                               ? (switches => ["-I$up/lib", $switch], nolib => 1)
                               : (switches => [$switch])
                                );