From: RonaldWS@aol.com <RonaldWS@aol.com>
Date: Sun, 30 May 1999 16:27:28 +0000 (-0400)
Subject: adapted suggested tests for addition to testsuite
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=d91d68c10c209afd8c4afd24673b7e49effc1e4b;p=p5sagit%2Fp5-mst-13.2.git

adapted suggested tests for addition to testsuite
	Message-Id:  <25cd799f.2482f930@aol.com>
	Subject: [19990530.007] Open with pipe | does not return pid under win32

p4raw-id: //depot/perl@3573
---

diff --git a/MANIFEST b/MANIFEST
index 6daa885..efe1f3c 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -1077,6 +1077,7 @@ t/io/fs.t		See if directory manipulations work
 t/io/inplace.t		See if inplace editing works
 t/io/iprefix.t		See if inplace editing works with prefixes
 t/io/open.t		See if open works
+t/io/openpid.t		See if open works for subprocesses
 t/io/pipe.t		See if secure pipes work
 t/io/print.t		See if print commands work
 t/io/read.t		See if read works
diff --git a/t/io/openpid.t b/t/io/openpid.t
new file mode 100755
index 0000000..2d3ac9f
--- /dev/null
+++ b/t/io/openpid.t
@@ -0,0 +1,78 @@
+
+#!./perl
+
+#####################################################################
+#
+# Test for process id return value from open
+# Ronald Schmidt (The Software Path) RonaldWS@software-path.com
+#
+#####################################################################
+
+BEGIN {
+    chdir 't' if -d 't';
+    unshift @INC, '../lib';
+}
+
+
+use FileHandle;
+autoflush STDOUT 1;
+$SIG{PIPE} = 'IGNORE';
+
+print "1..10\n";
+
+$perl = "$^X -I../lib";
+
+#
+# commands run 4 perl programs.  Two of these programs write a
+# short message to STDOUT and exit.  Two of these programs
+# read from STDIN.  One reader never exits and must be killed.
+# the other reader reads one line, waits a few seconds and then
+# exits to test the waitpid function.
+#
+$cmd1 = qq/$perl -e "use FileHandle; autoflush STDOUT 1; / .
+        qq/print qq[first process\\n]; sleep 30;"/;
+$cmd2 = qq/$perl -e "use FileHandle; autoflush STDOUT 1; / .
+        qq/print qq[second process\\n]; sleep 30;"/;
+$cmd3 = qq/$perl -e "print <>;"/; # hangs waiting for end of STDIN
+$cmd4 = qq/$perl -e "print scalar <>;"/;
+
+#warn "#$cmd1\n#$cmd2\n#$cmd3\n#$cmd4\n";
+
+# start the processes
+$pid1 = open(FH1, "$cmd1 |") or print "not ";
+print "ok 1\n";
+$pid2 = open(FH2, "$cmd2 |") or print "not ";
+print "ok 2\n";
+$pid3 = open(FH3, "| $cmd3") or print "not ";
+print "ok 3\n";
+$pid4 = open(FH4, "| $cmd4") or print "not ";
+print "ok 4\n";
+
+print "# pids were $pid1, $pid2, $pid3, $pid4\n";
+
+# get message from first process and kill it
+chomp($from_pid1 = scalar(<FH1>));
+print "# child1 returned [$from_pid1]\nnot "
+    unless $from_pid1 eq 'first process';
+print "ok 5\n";
+$kill_cnt = kill STOP, $pid1;
+print "not " unless $kill_cnt == 1;
+print "ok 6\n";
+
+# get message from second process and kill second process and reader process
+chomp($from_pid2 = scalar(<FH2>));
+print "# child2 returned [$from_pid2]\nnot "
+    unless $from_pid2 eq 'second process';
+print "ok 7\n";
+$kill_cnt = kill STOP, $pid2, $pid3;
+print "not " unless $kill_cnt == 2;
+print "ok 8\n";
+
+# send one expected line of text to child process and then wait for it
+autoflush FH4 1;
+print FH4 "ok 9\n";
+print "# waiting for process $pid4 to exit\n";
+$reap_pid = waitpid $pid4, 0;
+print "# reaped pid $reap_pid != $pid4\nnot "
+    unless $reap_pid == $pid4;
+print "ok 10\n";
diff --git a/win32/win32.c b/win32/win32.c
index eb486e3..a8ba54d 100644
--- a/win32/win32.c
+++ b/win32/win32.c
@@ -2122,6 +2122,9 @@ win32_popen(const char *command, const char *mode)
 	win32_close(oldfd);
 
 	sv_setiv(*av_fetch(w32_fdpid, p[parent], TRUE), childpid);
+
+	/* set process id so that it can be returned by perl's open() */
+	PL_forkprocess = childpid;
     }
 
     /* we have an fd, return a file stream */