diff options
author | Roderick Schertler <roderick@gate.net> | 1996-12-18 22:19:54 -0500 |
---|---|---|
committer | Chip Salzenberg <chip@atlantic.net> | 1996-12-20 11:14:00 +1200 |
commit | 982b4e8fc47473059e209787b589853f4c8f8f9e (patch) | |
tree | de99decafe27d4c45d51e99300bdf4b64b3f9563 | |
parent | 7f3dfc00eaef7e421633b2b47af9963dbc626e75 (diff) | |
download | perl-982b4e8fc47473059e209787b589853f4c8f8f9e.tar.gz |
Re: Open3.pm tries to close unopened file handle
# This patch contains two new test files.
touch t/lib/open3.t t/lib/open2.t
chmod +x t/lib/open3.t t/lib/open2.t
exit 0
Here's the open2.pl/open3.pl/Open2.pl/Open3.pl overhaul I was talking
about.
- open2.pl and open3.pl become wrappers around the IPC:: versions.
- open2() becomes a wrapper around open3()
- New test files open2.t and open3.t
- Bug fixes:
- open3(WRITE, READ, '>&STDOUT') now works
- spurious warnings from close() when dup()ping squelched
- failed fork() wasn't detected properly
- remaining system calls checked for success
- package qualified bareword filehandles didn't used to work in
open2() if they were qualified with :: and in open3()
if they were qualified with '
p5p-msgid: <pzloavmd9h.fsf@eeyore.ibcinc.com>
-rw-r--r-- | MANIFEST | 2 | ||||
-rw-r--r-- | lib/IPC/Open2.pm | 62 | ||||
-rw-r--r-- | lib/IPC/Open3.pm | 136 | ||||
-rw-r--r-- | lib/open2.pl | 60 | ||||
-rw-r--r-- | lib/open3.pl | 110 | ||||
-rw-r--r-- | pod/perldiag.pod | 2 | ||||
-rw-r--r-- | pod/perlfunc.pod | 6 | ||||
-rwxr-xr-x | t/lib/open2.t | 39 | ||||
-rwxr-xr-x | t/lib/open3.t | 114 |
9 files changed, 297 insertions, 234 deletions
@@ -612,6 +612,8 @@ t/lib/io_xs.t See if XSUB methods from IO work t/lib/ndbm.t See if NDBM_File works t/lib/odbm.t See if ODBM_File works t/lib/opcode.t See if Opcode works +t/lib/open2.t See if IPC::Open3 works +t/lib/open3.t See if IPC::Open2 works t/lib/ops.t See if Opcode works t/lib/parsewords.t See if Text::ParseWords works t/lib/posix.t See if POSIX works diff --git a/lib/IPC/Open2.pm b/lib/IPC/Open2.pm index 35bb0d1f16..cfd15a848b 100644 --- a/lib/IPC/Open2.pm +++ b/lib/IPC/Open2.pm @@ -1,7 +1,14 @@ package IPC::Open2; + +use strict; +use vars qw($VERSION @ISA @EXPORT); + require 5.000; require Exporter; -use Carp; + +$VERSION = 1.01; +@ISA = qw(Exporter); +@EXPORT = qw(open2); =head1 NAME @@ -22,6 +29,13 @@ when you try open(HANDLE, "|cmd args|"); +If $rdr is a string (that is, a bareword filehandle rather than a glob +or a reference) and it begins with ">&", then the child will send output +directly to that file handle. If $wtr is a string that begins with +"<&", then WTR will be closed in the parent, and the child will read +from it directly. In both cases, there will be a dup(2) instead of a +pipe(2) made. + open2() returns the process ID of the child process. It doesn't return on failure: it just raises an exception matching C</^open2:/>. @@ -44,13 +58,11 @@ read and write a line from it. =head1 SEE ALSO -See L<open3> for an alternative that handles STDERR as well. +See L<IPC::Open3> for an alternative that handles STDERR as well. This +function is really just a wrapper around open3(). =cut -@ISA = qw(Exporter); -@EXPORT = qw(open2); - # &open2: tom christiansen, <tchrist@convex.com> # # usage: $pid = open2('rdr', 'wtr', 'some cmd and args'); @@ -67,41 +79,15 @@ See L<open3> for an alternative that handles STDERR as well. # # abort program if # rdr or wtr are null -# pipe or fork or exec fails +# a system call fails -$fh = 'FHOPEN000'; # package static in case called more than once +require IPC::Open3; sub open2 { - local($kidpid); - local($dad_rdr, $dad_wtr, @cmd) = @_; - - $dad_rdr ne '' || croak "open2: rdr should not be null"; - $dad_wtr ne '' || croak "open2: wtr should not be null"; - - # force unqualified filehandles into callers' package - local($package) = caller; - $dad_rdr =~ s/^([^']+$)/$package'$1/ unless ref $dad_rdr; - $dad_wtr =~ s/^([^']+$)/$package'$1/ unless ref $dad_wtr; - - local($kid_rdr) = ++$fh; - local($kid_wtr) = ++$fh; - - pipe($dad_rdr, $kid_wtr) || croak "open2: pipe 1 failed: $!"; - pipe($kid_rdr, $dad_wtr) || croak "open2: pipe 2 failed: $!"; - - if (($kidpid = fork) < 0) { - croak "open2: fork failed: $!"; - } elsif ($kidpid == 0) { - close $dad_rdr; close $dad_wtr; - open(STDIN, "<&$kid_rdr"); - open(STDOUT, ">&$kid_wtr"); - warn "execing @cmd\n" if $debug; - exec @cmd - or croak "open2: exec of @cmd failed"; - } - close $kid_rdr; close $kid_wtr; - select((select($dad_wtr), $| = 1)[0]); # unbuffer pipe - $kidpid; + my ($read, $write, @cmd) = @_; + local $Carp::CarpLevel = $Carp::CarpLevel + 1; + return IPC::Open3::_open3('open2', scalar caller, + $write, $read, '>&STDERR', @cmd); } -1; # so require is happy +1 diff --git a/lib/IPC/Open3.pm b/lib/IPC/Open3.pm index d416ae7886..5d8545889e 100644 --- a/lib/IPC/Open3.pm +++ b/lib/IPC/Open3.pm @@ -1,7 +1,18 @@ package IPC::Open3; + +use strict; +no strict 'refs'; # because users pass me bareword filehandles +use vars qw($VERSION @ISA @EXPORT $Fh $Me); + require 5.001; require Exporter; + use Carp; +use Symbol 'qualify'; + +$VERSION = 1.01; +@ISA = qw(Exporter); +@EXPORT = qw(open3); =head1 NAME @@ -9,7 +20,7 @@ IPC::Open3, open3 - open a process for reading, writing, and error handling =head1 SYNOPSIS - $pid = open3(\*WTRFH, \*RDRFH, \*ERRFH + $pid = open3(\*WTRFH, \*RDRFH, \*ERRFH 'some cmd and args', 'optarg', ...); =head1 DESCRIPTION @@ -29,12 +40,28 @@ writer, you'll have problems with blocking, which means you'll want to use select(), which means you'll have to use sysread() instead of normal stuff. -All caveats from open2() continue to apply. See L<open2> for details. +open3() returns the process ID of the child process. It doesn't return on +failure: it just raises an exception matching C</^open3:/>. -=cut +=head1 WARNING + +It will not create these file handles for you. You have to do this +yourself. So don't pass it empty variables expecting them to get filled +in for you. -@ISA = qw(Exporter); -@EXPORT = qw(open3); +Additionally, this is very dangerous as you may block forever. It +assumes it's going to talk to something like B<bc>, both writing to it +and reading from it. This is presumably safe because you "know" that +commands like B<bc> will read a line at a time and output a line at a +time. Programs like B<sort> that read their entire input stream first, +however, are quite apt to cause deadlock. + +The big problem with this approach is that if you don't have control +over source code being run in the the child process, you can't control +what it does with pipe buffering. Thus you can't just open a pipe to +C<cat -v> and continually read and write a line from it. + +=cut # &open3: Marc Horowitz <marc@mit.edu> # derived mostly from &open2 by tom christiansen, <tchrist@convex.com> @@ -48,7 +75,7 @@ All caveats from open2() continue to apply. See L<open2> for details. # reading, wtr for writing, and err for errors. # if err is '', or the same as rdr, then stdout and # stderr of the child are on the same fh. returns pid -# of child, or 0 on failure. +# of child (or dies on failure). # if wtr begins with '<&', then wtr will be closed in the parent, and @@ -64,17 +91,41 @@ All caveats from open2() continue to apply. See L<open2> for details. # # abort program if # rdr or wtr are null -# pipe or fork or exec fails +# a system call fails -$fh = 'FHOPEN000'; # package static in case called more than once +$Fh = 'FHOPEN000'; # package static in case called more than once +$Me = 'open3 (bug)'; # you should never see this, it's always localized -sub open3 { - my($kidpid); - my($dad_wtr, $dad_rdr, $dad_err, @cmd) = @_; - my($dup_wtr, $dup_rdr, $dup_err); +# Fatal.pm needs to be fixed WRT prototypes. + +sub xfork { + my $pid = fork; + defined $pid or croak "$Me: fork failed: $!"; + return $pid; +} + +sub xpipe { + pipe $_[0], $_[1] or croak "$Me: pipe($_[0], $_[1]) failed: $!"; +} + +# I tried using a * prototype character for the filehandle but it still +# disallows a bearword while compiling under strict subs. - $dad_wtr || croak "open3: wtr should not be null"; - $dad_rdr || croak "open3: rdr should not be null"; +sub xopen { + open $_[0], $_[1] or croak "$Me: open($_[0], $_[1]) failed: $!"; +} + +sub xclose { + close $_[0] or croak "$Me: close($_[0]) failed: $!"; +} + +sub _open3 { + local $Me = shift; + my($package, $dad_wtr, $dad_rdr, $dad_err, @cmd) = @_; + my($dup_wtr, $dup_rdr, $dup_err, $kidpid); + + $dad_wtr or croak "$Me: wtr should not be null"; + $dad_rdr or croak "$Me: rdr should not be null"; $dad_err = $dad_rdr if ($dad_err eq ''); $dup_wtr = ($dad_wtr =~ s/^[<>]&//); @@ -82,28 +133,29 @@ sub open3 { $dup_err = ($dad_err =~ s/^[<>]&//); # force unqualified filehandles into callers' package - my($package) = caller; - $dad_wtr =~ s/^([^:]+$)/$package\:\:$1/ unless ref $dad_wtr; - $dad_rdr =~ s/^([^:]+$)/$package\:\:$1/ unless ref $dad_rdr; - $dad_err =~ s/^([^:]+$)/$package\:\:$1/ unless ref $dad_err; - - my($kid_rdr) = ++$fh; - my($kid_wtr) = ++$fh; - my($kid_err) = ++$fh; - - if (!$dup_wtr) { - pipe($kid_rdr, $dad_wtr) || croak "open3: pipe 1 (stdin) failed: $!"; - } - if (!$dup_rdr) { - pipe($dad_rdr, $kid_wtr) || croak "open3: pipe 2 (stdout) failed: $!"; - } - if ($dad_err ne $dad_rdr && !$dup_err) { - pipe($dad_err, $kid_err) || croak "open3: pipe 3 (stderr) failed: $!"; - } + $dad_wtr = qualify $dad_wtr, $package; + $dad_rdr = qualify $dad_rdr, $package; + $dad_err = qualify $dad_err, $package; + + my $kid_rdr = ++$Fh; + my $kid_wtr = ++$Fh; + my $kid_err = ++$Fh; + + xpipe $kid_rdr, $dad_wtr if !$dup_wtr; + xpipe $dad_rdr, $kid_wtr if !$dup_rdr; + xpipe $dad_err, $kid_err if !$dup_err && $dad_err ne $dad_rdr; + + $kidpid = xfork; + if ($kidpid == 0) { + # If she wants to dup the kid's stderr onto her stdout I need to + # save a copy of her stdout before I put something else there. + if ($dad_rdr ne $dad_err && $dup_err + && fileno($dad_err) == fileno(STDOUT)) { + my $tmp = ++$Fh; + xopen($tmp, ">&$dad_err"); + $dad_err = $tmp; + } - if (($kidpid = fork) < 0) { - croak "open3: fork failed: $!"; - } elsif ($kidpid == 0) { if ($dup_wtr) { open(STDIN, "<&$dad_wtr") if (fileno(STDIN) != fileno($dad_wtr)); } else { @@ -132,13 +184,19 @@ sub open3 { or croak "open3: exec of @cmd failed"; } - close $kid_rdr; close $kid_wtr; close $kid_err; - if ($dup_wtr) { - close($dad_wtr); - } + xclose $kid_rdr if !$dup_wtr; + xclose $kid_wtr if !$dup_rdr; + xclose $kid_err if !$dup_err && $dad_rdr ne $dad_err; + # If the write handle is a dup give it away entirely, close my copy + # of it. + xclose $dad_wtr if $dup_wtr; select((select($dad_wtr), $| = 1)[0]); # unbuffer pipe $kidpid; } + +sub open3 { + return _open3 'open3', scalar caller, @_ +} 1; # so require is happy diff --git a/lib/open2.pl b/lib/open2.pl index 7d3b97030b..8cf08c2e8b 100644 --- a/lib/open2.pl +++ b/lib/open2.pl @@ -1,54 +1,12 @@ -# &open2: tom christiansen, <tchrist@convex.com> +# This is a compatibility interface to IPC::Open2. New programs should +# do # -# usage: $pid = &open2('rdr', 'wtr', 'some cmd and args'); -# or $pid = &open2('rdr', 'wtr', 'some', 'cmd', 'and', 'args'); +# use IPC::Open2; # -# spawn the given $cmd and connect $rdr for -# reading and $wtr for writing. return pid -# of child, or 0 on failure. -# -# WARNING: this is dangerous, as you may block forever -# unless you are very careful. -# -# $wtr is left unbuffered. -# -# abort program if -# rdr or wtr are null -# pipe or fork or exec fails - -package open2; -$fh = 'FHOPEN000'; # package static in case called more than once - -sub main'open2 { - local($kidpid); - local($dad_rdr, $dad_wtr, @cmd) = @_; - - $dad_rdr ne '' || die "open2: rdr should not be null"; - $dad_wtr ne '' || die "open2: wtr should not be null"; - - # force unqualified filehandles into callers' package - local($package) = caller; - $dad_rdr =~ s/^([^']+$)/$package'$1/; - $dad_wtr =~ s/^([^']+$)/$package'$1/; - - local($kid_rdr) = ++$fh; - local($kid_wtr) = ++$fh; - - pipe($dad_rdr, $kid_wtr) || die "open2: pipe 1 failed: $!"; - pipe($kid_rdr, $dad_wtr) || die "open2: pipe 2 failed: $!"; +# instead of +# +# require 'open2.pl'; - if (($kidpid = fork) < 0) { - die "open2: fork failed: $!"; - } elsif ($kidpid == 0) { - close $dad_rdr; close $dad_wtr; - open(STDIN, "<&$kid_rdr"); - open(STDOUT, ">&$kid_wtr"); - warn "execing @cmd\n" if $debug; - exec @cmd; - die "open2: exec of @cmd failed"; - } - close $kid_rdr; close $kid_wtr; - select((select($dad_wtr), $| = 1)[0]); # unbuffer pipe - $kidpid; -} -1; # so require is happy +package main; +use IPC::Open2 'open2'; +1 diff --git a/lib/open3.pl b/lib/open3.pl index 8b3917a851..7fcc931861 100644 --- a/lib/open3.pl +++ b/lib/open3.pl @@ -1,106 +1,12 @@ -# &open3: Marc Horowitz <marc@mit.edu> -# derived mostly from &open2 by tom christiansen, <tchrist@convex.com> +# This is a compatibility interface to IPC::Open3. New programs should +# do # -# $Id: open3.pl,v 1.1 1993/11/23 06:26:15 marc Exp $ +# use IPC::Open3; # -# usage: $pid = open3('wtr', 'rdr', 'err' 'some cmd and args', 'optarg', ...); +# instead of # -# spawn the given $cmd and connect rdr for -# reading, wtr for writing, and err for errors. -# if err is '', or the same as rdr, then stdout and -# stderr of the child are on the same fh. returns pid -# of child, or 0 on failure. +# require 'open3.pl'; - -# if wtr begins with '>&', then wtr will be closed in the parent, and -# the child will read from it directly. if rdr or err begins with -# '>&', then the child will send output directly to that fd. In both -# cases, there will be a dup() instead of a pipe() made. - - -# WARNING: this is dangerous, as you may block forever -# unless you are very careful. -# -# $wtr is left unbuffered. -# -# abort program if -# rdr or wtr are null -# pipe or fork or exec fails - -package open3; - -$fh = 'FHOPEN000'; # package static in case called more than once - -sub main'open3 { - local($kidpid); - local($dad_wtr, $dad_rdr, $dad_err, @cmd) = @_; - local($dup_wtr, $dup_rdr, $dup_err); - - $dad_wtr || die "open3: wtr should not be null"; - $dad_rdr || die "open3: rdr should not be null"; - $dad_err = $dad_rdr if ($dad_err eq ''); - - $dup_wtr = ($dad_wtr =~ s/^\>\&//); - $dup_rdr = ($dad_rdr =~ s/^\>\&//); - $dup_err = ($dad_err =~ s/^\>\&//); - - # force unqualified filehandles into callers' package - local($package) = caller; - $dad_wtr =~ s/^([^']+$)/$package'$1/; - $dad_rdr =~ s/^([^']+$)/$package'$1/; - $dad_err =~ s/^([^']+$)/$package'$1/; - - local($kid_rdr) = ++$fh; - local($kid_wtr) = ++$fh; - local($kid_err) = ++$fh; - - if (!$dup_wtr) { - pipe($kid_rdr, $dad_wtr) || die "open3: pipe 1 (stdin) failed: $!"; - } - if (!$dup_rdr) { - pipe($dad_rdr, $kid_wtr) || die "open3: pipe 2 (stdout) failed: $!"; - } - if ($dad_err ne $dad_rdr && !$dup_err) { - pipe($dad_err, $kid_err) || die "open3: pipe 3 (stderr) failed: $!"; - } - - if (($kidpid = fork) < 0) { - die "open2: fork failed: $!"; - } elsif ($kidpid == 0) { - if ($dup_wtr) { - open(STDIN, "<&$dad_wtr") if (fileno(STDIN) != fileno($dad_wtr)); - } else { - close($dad_wtr); - open(STDIN, "<&$kid_rdr"); - } - if ($dup_rdr) { - open(STDOUT, ">&$dad_rdr") if (fileno(STDOUT) != fileno($dad_rdr)); - } else { - close($dad_rdr); - open(STDOUT, ">&$kid_wtr"); - } - if ($dad_rdr ne $dad_err) { - if ($dup_err) { - open(STDERR, ">&$dad_err") - if (fileno(STDERR) != fileno($dad_err)); - } else { - close($dad_err); - open(STDERR, ">&$kid_err"); - } - } else { - open(STDERR, ">&STDOUT") if (fileno(STDERR) != fileno(STDOUT)); - } - local($")=(" "); - exec @cmd; - die "open2: exec of @cmd failed"; - } - - close $kid_rdr; close $kid_wtr; close $kid_err; - if ($dup_wtr) { - close($dad_wtr); - } - - select((select($dad_wtr), $| = 1)[0]); # unbuffer pipe - $kidpid; -} -1; # so require is happy +package main; +use IPC::Open3 'open3'; +1 diff --git a/pod/perldiag.pod b/pod/perldiag.pod index bbd699faaa..d08c53a94d 100644 --- a/pod/perldiag.pod +++ b/pod/perldiag.pod @@ -635,7 +635,7 @@ Usually this is because you don't have read permission for the file. (W) You tried to say C<open(CMD, "|cmd|")>, which is not supported. You can try any of several modules in the Perl library to do this, such as -"open2.pl". Alternately, direct the pipe's output to a file using "E<gt>", +IPC::Open2. Alternately, direct the pipe's output to a file using "E<gt>", and then read it in under a different file handle. =item Can't open error file %s as stderr diff --git a/pod/perlfunc.pod b/pod/perlfunc.pod index 49b77f02fc..1148176120 100644 --- a/pod/perlfunc.pod +++ b/pod/perlfunc.pod @@ -1754,8 +1754,8 @@ If the filename begins with "|", the filename is interpreted as a command to which output is to be piped, and if the filename ends with a "|", the filename is interpreted See L<perlipc/"Using open() for IPC"> for more examples of this. as command which pipes input to us. (You may not have -a raw open() to a command that pipes both in I<and> out, but see L<open2>, -L<open3>, and L<perlipc/"Bidirectional Communication"> for alternatives.) +a raw open() to a command that pipes both in I<and> out, but see L<IPC::Open2>, +L<IPC::Open3>, and L<perlipc/"Bidirectional Communication"> for alternatives.) Opening '-' opens STDIN and opening 'E<gt>-' opens STDOUT. Open returns non-zero upon success, the undefined value otherwise. If the open @@ -2052,7 +2052,7 @@ unless you are very careful. In addition, note that Perl's pipes use stdio buffering, so you may need to set C<$|> to flush your WRITEHANDLE after each command, depending on the application. -See L<open2>, L<open3>, and L<perlipc/"Bidirectional Communication"> +See L<IPC::Open2>, L<IPC::Open3>, and L<perlipc/"Bidirectional Communication"> for examples of such things. =item pop ARRAY diff --git a/t/lib/open2.t b/t/lib/open2.t index e69de29bb2..8dd786b76e 100755 --- a/t/lib/open2.t +++ b/t/lib/open2.t @@ -0,0 +1,39 @@ +#!./perl -w +use strict; + +BEGIN { + chdir 't' if -d 't'; + @INC = '../lib'; + # make warnings fatal + $SIG{__WARN__} = sub { die @_ }; +} + +use IO::Handle; +use IPC::Open2; +#require 'open2.pl'; use subs 'open2'; + +sub ok { + my ($n, $result, $info) = @_; + if ($result) { + print "ok $n\n"; + } + else { + print "not ok $n\n"; + print "# $info\n" if $info; + } +} + +my ($pid, $reaped_pid); +STDOUT->autoflush; +STDERR->autoflush; + +print "1..7\n"; + +ok 1, $pid = open2 'READ', 'WRITE', $^X, '-e', 'print scalar <STDIN>'; +ok 2, print WRITE "hi kid\n"; +ok 3, <READ> eq "hi kid\n"; +ok 4, close(WRITE), $!; +ok 5, close(READ), $!; +$reaped_pid = waitpid $pid, 0; +ok 6, $reaped_pid == $pid, $reaped_pid; +ok 7, $? == 0, $?; diff --git a/t/lib/open3.t b/t/lib/open3.t index e69de29bb2..a4a978ebea 100755 --- a/t/lib/open3.t +++ b/t/lib/open3.t @@ -0,0 +1,114 @@ +#!./perl -w +use strict; + +BEGIN { + chdir 't' if -d 't'; + @INC = '../lib'; + # make warnings fatal + $SIG{__WARN__} = sub { die @_ }; +} + +use IO::Handle; +use IPC::Open3; +#require 'open3.pl'; use subs 'open3'; + +sub ok { + my ($n, $result, $info) = @_; + if ($result) { + print "ok $n\n"; + } + else { + print "not ok $n\n"; + print "# $info\n" if $info; + } +} + +my ($pid, $reaped_pid); +STDOUT->autoflush; +STDERR->autoflush; + +print "1..21\n"; + +# basic +ok 1, $pid = open3 'WRITE', 'READ', 'ERROR', $^X, '-e', <<'EOF'; + $| = 1; + print scalar <STDIN>; + print STDERR "hi error\n"; +EOF +ok 2, print WRITE "hi kid\n"; +ok 3, <READ> eq "hi kid\n"; +ok 4, <ERROR> eq "hi error\n"; +ok 5, close(WRITE), $!; +ok 6, close(READ), $!; +ok 7, close(ERROR), $!; +$reaped_pid = waitpid $pid, 0; +ok 8, $reaped_pid == $pid, $reaped_pid; +ok 9, $? == 0, $?; + +# read and error together, both named +$pid = open3 'WRITE', 'READ', 'READ', $^X, '-e', <<'EOF'; + $| = 1; + print scalar <STDIN>; + print STDERR scalar <STDIN>; +EOF +print WRITE "ok 10\n"; +print scalar <READ>; +print WRITE "ok 11\n"; +print scalar <READ>; +waitpid $pid, 0; + +# read and error together, error empty +$pid = open3 'WRITE', 'READ', '', $^X, '-e', <<'EOF'; + $| = 1; + print scalar <STDIN>; + print STDERR scalar <STDIN>; +EOF +print WRITE "ok 12\n"; +print scalar <READ>; +print WRITE "ok 13\n"; +print scalar <READ>; +waitpid $pid, 0; + +# dup writer +ok 14, pipe PIPE_READ, PIPE_WRITE; +$pid = open3 '<&PIPE_READ', 'READ', '', + $^X, '-e', 'print scalar <STDIN>'; +close PIPE_READ; +print PIPE_WRITE "ok 15\n"; +close PIPE_WRITE; +print scalar <READ>; +waitpid $pid, 0; + +# dup reader +$pid = open3 'WRITE', '>&STDOUT', 'ERROR', + $^X, '-e', 'print scalar <STDIN>'; +print WRITE "ok 16\n"; +waitpid $pid, 0; + +# dup error: This particular case, duping stderr onto the existing +# stdout but putting stdout somewhere else, is a good case because it +# used not to work. +$pid = open3 'WRITE', 'READ', '>&STDOUT', + $^X, '-e', 'print STDERR scalar <STDIN>'; +print WRITE "ok 17\n"; +waitpid $pid, 0; + +# dup reader and error together, both named +$pid = open3 'WRITE', '>&STDOUT', '>&STDOUT', $^X, '-e', <<'EOF'; + $| = 1; + print STDOUT scalar <STDIN>; + print STDERR scalar <STDIN>; +EOF +print WRITE "ok 18\n"; +print WRITE "ok 19\n"; +waitpid $pid, 0; + +# dup reader and error together, error empty +$pid = open3 'WRITE', '>&STDOUT', '', $^X, '-e', <<'EOF'; + $| = 1; + print STDOUT scalar <STDIN>; + print STDERR scalar <STDIN>; +EOF +print WRITE "ok 20\n"; +print WRITE "ok 21\n"; +waitpid $pid, 0; |