document unimplemented status of forking pipe open() on windows

p4raw-id: //depot/perl@4914

2 files changed, 114 insertions, 0 deletions

diff --git a/pod/perlfork.pod b/pod/perlfork.pod
index 6c11b5e662..d930e9396e 100644
--- a/pod/perlfork.pod
+++ b/pod/perlfork.pod
@@ -172,6 +172,73 @@ the seek position in the parent will change it in the child and vice-versa.
 One can avoid this by opening files that need distinct seek pointers
 separately in the child.
 
+=item Forking pipe open() not yet implemented
+
+The C<open(FOO, "|-")> and C<open(BAR, "-|")> constructs are not yet
+implemented.  This limitation can be easily worked around in new code
+by creating a pipe explicitly.  The following example shows how to
+write to a forked child:
+
+    # simulate open(FOO, "|-")
+    sub pipe_to_fork ($) {
+	my $parent = shift;
+	pipe my $child, $parent or die;
+	my $pid = fork();
+	die "fork() failed: $!" unless defined $pid;
+	if ($pid) {
+	    close $child;
+	}
+	else {
+	    close $parent;
+	    open(STDIN, "<&=" . fileno($child)) or die;
+	}
+	$pid;
+    }
+
+    if (pipe_to_fork('FOO')) {
+	# parent
+	print FOO "pipe_to_fork\n";
+	close FOO;
+    }
+    else {
+	# child
+	while (<STDIN>) { print; }
+	close STDIN;
+	exit(0);
+    }
+
+And this one reads from the child:
+
+    # simulate open(FOO, "-|")
+    sub pipe_from_fork ($) {
+	my $parent = shift;
+	pipe $parent, my $child or die;
+	my $pid = fork();
+	die "fork() failed: $!" unless defined $pid;
+	if ($pid) {
+	    close $child;
+	}
+	else {
+	    close $parent;
+	    open(STDOUT, ">&=" . fileno($child)) or die;
+	}
+	$pid;
+    }
+
+    if (pipe_from_fork('BAR')) {
+	# parent
+	while (<BAR>) { print; }
+	close BAR;
+    }
+    else {
+	# child
+	print "pipe_from_fork\n";
+	close STDOUT;
+	exit(0);
+    }
+
+Forking pipe open() constructs will be supported in future.
+
 =item Global state maintained by XSUBs 
 
 External subroutines (XSUBs) that maintain their own global state may
diff --git a/t/op/fork.t b/t/op/fork.t
index 11efa79d17..f3d74f978f 100755
--- a/t/op/fork.t
+++ b/t/op/fork.t
@@ -320,3 +320,50 @@ BEGIN {
 #print "outer\n"
 EXPECT
 inner
+########
+sub pipe_to_fork ($$) {
+    my $parent = shift;
+    my $child = shift;
+    pipe($child, $parent) or die;
+    my $pid = fork();
+    die "fork() failed: $!" unless defined $pid;
+    close($pid ? $child : $parent);
+    $pid;
+}
+
+if (pipe_to_fork('PARENT','CHILD')) {
+    # parent
+    print PARENT "pipe_to_fork\n";
+    close PARENT;
+}
+else {
+    # child
+    while (<CHILD>) { print; }
+    close CHILD;
+    exit;
+}
+
+sub pipe_from_fork ($$) {
+    my $parent = shift;
+    my $child = shift;
+    pipe($parent, $child) or die;
+    my $pid = fork();
+    die "fork() failed: $!" unless defined $pid;
+    close($pid ? $child : $parent);
+    $pid;
+}
+
+if (pipe_from_fork('PARENT','CHILD')) {
+    # parent
+    while (<PARENT>) { print; }
+    close PARENT;
+}
+else {
+    # child
+    print CHILD "pipe_from_fork\n";
+    close CHILD;
+    exit;
+}
+EXPECT
+pipe_from_fork
+pipe_to_fork