import version 0.032 from backpan

Changes

@@ -1,5 +1,16 @@
 Changes file for IPC::Run3
 
+0.032	2005-10-19
+        comaint granted to RSCHUPP (thanks, barry!)
+        fix bug #15003 "Data corruption with fork when both parent 
+          and child use run3": 
+          - purge %fh_cache when we detect that a fork has happened
+          - add t/fork.t to detect "crossover" between child processes
+          - fix (and test) only works on Unix, Windows has more
+            problems with run3 from a forked (pseudo) process
+        fix prereq - should specify 0 (not 1) if any version will do
+	added tests for redirection to/from filehandles to t/IPC-Run3.t
+
 0.031   2005-09-27
         documentation improvements
 

MANIFEST

@@ -18,7 +18,7 @@ t/IPC-Run3-ProfReporter.t
 t/IPC-Run3-profiling.t
 t/IPC-Run3.t
 t/fd_leak.t
-t/test.txt
+t/fork.t
 t/pod-coverage.t
 t/pod.t
 META.yml                                 Module meta-data (added by MakeMaker)

MANIFEST.SKIP

@@ -7,6 +7,7 @@ CVS/.*
 ^mess/
 ^tmp/
 ^blib/
+^t/test.txt$
 ^Makefile$
 ^Makefile\.[a-z]+$
 ^pm_to_blib$

Makefile.PL

@@ -5,7 +5,8 @@ WriteMakefile(
     VERSION_FROM  => 'lib/IPC/Run3.pm',
     EXE_FILES     => [],
     PREREQ_PM => {
-      'Time::HiRes' => 1,
-      ($^O =~ /Win32/ ? (Win32 => 1) : ())
+      'Time::HiRes' => 0,
+      ($^O =~ /Win32/ ? (Win32 => 0) : ())
     },
+    clean => { FILES => "t/test.txt" },
 );

lib/IPC/Run3.pm

@@ -6,11 +6,11 @@ IPC::Run3 - run a subprocess in batch mode (a la system) on Unix, Win32, etc.
 
 =head1 VERSION
 
-version 0.031
+version 0.032
 
 =cut
 
-$VERSION = '0.031';
+$VERSION = '0.032';
 
 =head1 SYNOPSIS
 
@@ -164,6 +164,7 @@ use POSIX qw( dup dup2 );
 # We cache the handles of our temp files in order to
 # keep from having to incur the (largish) overhead of File::Temp
 my %fh_cache;
+my $fh_cache_pid = $$;
 
 my $profiler;
 
@@ -423,6 +424,13 @@ sub run3 {
     my $out_type = _type $stdout;
     my $err_type = _type $stderr;
 
+    if ($fh_cache_pid != $$) {
+	# fork detected, close all cached filehandles and clear the cache
+	close $_ foreach values %fh_cache;
+	%fh_cache = ();
+	$fh_cache_pid = $$;
+    }
+
     # This routine procedes in stages so that a failure in an early
     # stage prevents later stages from running, and thus from needing
     # cleanup.

t/IPC-Run3.t

@@ -104,6 +104,31 @@ sub {
     ok -s $fn, 3;
 },
 
+sub {
+    my $fn = "t/test.txt";
+    open FH, ">$fn" or warn "$! opening $fn";
+
+    ( $in, $out, $err ) = ();
+    run3 [$^X, '-e', 'print "OUT"' ], \undef, \*FH;
+
+    close FH;
+    ok -s $fn, 3;
+},
+
+sub {
+    my $fn = "t/test.txt";
+    open FH, ">$fn" or warn "$! opening $fn";
+    print FH "IN1\IN2\n";
+    close FH;
+
+    open FH, "<$fn" or warn "$! opening $fn";
+
+    ( $in, $out, $err ) = ();
+    run3 [$^X, '-e', 'print <>' ], \*FH, \$out;
+
+    close FH;
+    ok $out, "IN1\IN2\n";
+},
 );
 
 plan tests => 0+@tests;

t/fork.t

@@ -0,0 +1,72 @@
+use Test::More;
+use IPC::Run3;
+use POSIX;
+use strict;
+
+if ($^O =~ /Win32/) { plan skip_all => 'fork tests fail on Windows'; }
+else		    { plan tests => 5; }
+
+sub echo
+{
+    my $exp = shift;
+    my $got;
+    run3 [ $^X, "-e", "print '$exp'" ], \undef, \$got, \undef;
+    return ($got, $exp);
+}
+
+my ($got, $exp);
+
+# force IPC::Run3 into populating %fh_cache 
+# by running echo once in the parent
+($got, $exp) = echo("parent$$");
+is($got, $exp, "echo parent before fork");
+
+if (my $pid = fork)
+{
+    # parent
+    ok(waitpid(-1, 0) > 0 && $? == 0, "echo child");
+}
+else
+{
+    # child
+    my ($got, $exp) = echo("child$$");
+
+    # don't use exit() or die() because they will run the END block
+    # set up by Test::More in the child (so that it gets run twice)
+    POSIX::_exit(0) if $exp eq $got;
+
+    warn qq[child $$: expected "$exp", got "$got"\n];
+    POSIX::_exit(1);
+}
+
+($got, $exp) = echo("parent$$");
+is($got, $exp, "echo parent after fork");
+
+# now run several child processes in parallel,
+# all calling run3 repeatedly
+my ($kids, $runs) = (5, 10);	# usually enough, even on uniprocessor systems
+
+for (1..$kids)
+{
+    unless (fork)
+    {
+        # child
+	for (1..$runs)
+	{
+	    my ($got, $exp) = echo("child$$:run$_");
+	    POSIX::_exit(0) if $exp eq $got;
+
+	    warn qq[child $$: expected "$exp", got "$got"\n];
+	    POSIX::_exit(1);
+	}
+    }
+}
+
+my ($failed, $reaped);
+while (waitpid(-1, 0) > 0)
+{
+    $reaped++;
+    $failed++ unless $? == 0;
+}
+ok($reaped == $kids, "run $kids parallel child processes");
+ok($failed == 0, "check for filehandle crossover");