Tests for having multiple pipes open simultaneously.

(See comment added in change 3771 about this apparently being buggy)

p4raw-id: //depot/perl@27813

1 files changed, 63 insertions, 2 deletions

diff --git a/t/op/inccode.t b/t/op/inccode.t
index 8ce41ab399..f89785243c 100644
--- a/t/op/inccode.t
+++ b/t/op/inccode.t
@@ -2,15 +2,24 @@
 
 # Tests for the coderef-in-@INC feature
 
+my $can_fork = 0;
 BEGIN {
     chdir 't' if -d 't';
     @INC = qw(. ../lib);
 }
+{
+    use Config; 
+    if (PerlIO::Layer->find('perlio') && $Config{d_fork} &&
+	eval 'require POSIX; 1') {
+	$can_fork = 1;
+    }
+}
 
+use strict;
 use File::Spec;
 
 require "test.pl";
-plan(tests => 45);
+plan(tests => 45 + 14 * $can_fork);
 
 my @tempfiles = ();
 
@@ -184,7 +193,7 @@ push @INC, sub {
     }
 };
 
-$ret = "";
+my $ret = "";
 $ret ||= do 'abc.pl';
 is( $ret, 'abc', 'do "abc.pl" sees return value' );
 
@@ -197,3 +206,55 @@ my $filename = $^O eq 'MacOS' ? ':Foo:Foo.pm' : './Foo.pm';
     eval { require $filename; };
     is( $filename, 'seen', 'the coderef sees fully-qualified pathnames' );
 }
+
+if ($can_fork) {
+    require PerlIO::scalar;
+    # This little bundle of joy generates n more recursive use statements,
+    # with each module chaining the next one down to 0. If it works, then we
+    # can safely nest subprocesses
+    my $use_filter_too;
+    push @INC, sub {
+	return unless $_[1] =~ /^BBBLPLAST(\d+)\.pm/;
+	my $pid = open my $fh, "-|";
+	if ($pid) {
+	    # Parent
+	    return $fh unless $use_filter_too;
+	    # Try filters and state in addition.
+	    return ($fh, sub {s/$_[1]/pass/; return}, "die")
+	}
+	die "Can't fork self: $!" unless defined $pid;
+
+	# Child
+	my $count = $1;
+	# Lets force some fun with odd sized reads.
+	$| = 1;
+	print 'push @main::bbblplast, ';
+	print "$count;\n";
+	if ($count--) {
+	    print "use BBBLPLAST$count;\n";
+	}
+	if ($use_filter_too) {
+	    print "die('In $_[1]');";
+	} else {
+	    print "pass('In $_[1]');";
+	}
+	print '"Truth"';
+	POSIX::_exit(0);
+	die "Can't get here: $!";
+    };
+
+    @::bbblplast = ();
+    require BBBLPLAST5;
+    is ("@::bbblplast", "0 1 2 3 4 5", "All ran");
+
+    foreach (keys %INC) {
+	delete $INC{$_} if /^BBBLPLAST/;
+    }
+
+    @::bbblplast = ();
+    $use_filter_too = 1;
+
+    require BBBLPLAST5;
+
+    is ("@::bbblplast", "0 1 2 3 4 5", "All ran with a filter");
+}