In perl.git, the branch blead has been updated
<http://perl5.git.perl.org/perl.git/commitdiff/258a58987ee2cc2be52e4eec4f8e68af1693368b?hp=26126efb9b317f88a49cd14c7ef5c20eb0cb68b1>
- Log -----------------------------------------------------------------
commit 258a58987ee2cc2be52e4eec4f8e68af1693368b
Author: Nicholas Clark <n...@ccl4.org>
Date: Tue Jun 7 13:17:40 2011 +0200
In IPC::Open3, inline xfork() and xclose_on_exec(), and delete xpipe_anon().
All three functions are private, undocumented, unexported, and un(ab)used by
any code on CPAN. The first two are used in only one place, so inline them.
The third was added in 8960aa876f446ad2, without adding any code which used
it,
and it has remained unused ever since.
M ext/IPC-Open3/lib/IPC/Open3.pm
commit a500d2749bb1094d4970754f2305094719c8cca4
Author: Nicholas Clark <n...@ccl4.org>
Date: Tue Jun 7 13:00:33 2011 +0200
In IPC::Open3::_open(), refactor the DO_SPAWN code to loop over @handles.
M ext/IPC-Open3/lib/IPC/Open3.pm
commit afebf859d54e3d4c2acd44b2c2bdc2ac1e298eb3
Author: Nicholas Clark <n...@ccl4.org>
Date: Tue Jun 7 12:37:28 2011 +0200
In IPC::Open3::_open(), refactor the fork/exec code to loop over @handles.
M ext/IPC-Open3/lib/IPC/Open3.pm
commit 0c12e47ae20ac31659a9f4daa9df439caca65d08
Author: Nicholas Clark <n...@ccl4.org>
Date: Mon Jun 6 20:45:13 2011 +0200
In IPC::Open3::_open(), refactor the common code into loops over @handles.
As fh_is_fd() is now used in only one location, inline it. (This function
isn't
exported, isn't documented, and isn't (ab)used by anything on CPAN.)
M ext/IPC-Open3/lib/IPC/Open3.pm
commit cae0d2696383fe61e20cd1cd2c994c1d8e4f5512
Author: Nicholas Clark <n...@ccl4.org>
Date: Mon Jun 6 19:48:03 2011 +0200
In IPC::Open3::_open(), switch from 'r' and 'w' to '<' and '>'.
IO::Handle accepts either, but open only accepts the latter.
In spawn_with_handles(), hoist the C<require Fcntl> into the only block that
needs it - this avoids loading Fcntl on Win32.
M ext/IPC-Open3/lib/IPC/Open3.pm
commit f2412f8992265c5e91329c250ba4711946a5e321
Author: Nicholas Clark <n...@ccl4.org>
Date: Mon Jun 6 19:19:29 2011 +0200
Use $handles[2]{dup_of_out} for the special case code for shared
STD{OUT,ERR}.
As C<dup_of_out> is never set on the other two members of @handles, this
will
allow code simplification.
M ext/IPC-Open3/lib/IPC/Open3.pm
commit b38d735f00806962171b7b16c49e3fd64075ecb9
Author: Nicholas Clark <n...@ccl4.org>
Date: Mon Jun 6 18:26:35 2011 +0200
In IPC::Open3::_open3(), move $kid_{rdr,wtr,err} to @handles.
Switch to 3-arg open where code is changing.
M ext/IPC-Open3/lib/IPC/Open3.pm
commit 38e62fca654d22f4ba242a25fef760147ca63323
Author: Nicholas Clark <n...@ccl4.org>
Date: Mon Jun 6 18:02:33 2011 +0200
In IPC::Open3::_open3(), move $dup_{wtr,rdr,err} to @handles.
M ext/IPC-Open3/lib/IPC/Open3.pm
commit 9340a1e0fabc8763003cd498b766316ec18fdc4b
Author: Nicholas Clark <n...@ccl4.org>
Date: Mon Jun 6 17:11:35 2011 +0200
In IPC::Open3::_open3(), move $dad_{wtr,rdr,err} to @handles.
Switch to 3-arg open where code is changing. Additionally, @_ can now be
used
in place of @cmd.
M ext/IPC-Open3/lib/IPC/Open3.pm
commit b74a613e3e588946368dbb832eaeb7328c147bdc
Author: Nicholas Clark <n...@ccl4.org>
Date: Mon Jun 6 15:02:22 2011 +0200
Move the table describing file handles near to the top of
IPC::Open::open3().
Also convert fileno BAREWORD to fileno \*BAREWORD. These will aid future
refactoring.
M ext/IPC-Open3/lib/IPC/Open3.pm
commit cf0c26e1e5a2c4feb57f6d36050415159796e762
Author: Nicholas Clark <n...@ccl4.org>
Date: Mon Jun 6 14:43:56 2011 +0200
Move the autovivification emulation code to the top of IPC::Open3::_open3().
This avoids having to re-assign to the scalars $dad_wtr and $dad_rdr.
M ext/IPC-Open3/lib/IPC/Open3.pm
commit 0689e260481390ae18db4d1043f84f46f17a2951
Author: Nicholas Clark <n...@ccl4.org>
Date: Mon Jun 6 14:29:19 2011 +0200
Refactor IPC::Open3::_open3() to find the caller's package itself.
Previously it was passed in as a parameter by IPC::Open2::open2() and
IPC::Open3::open3(), each of which used C<calller> to find it. Move the use
of
caller to one place.
It would also be possible to use C<caller> to eliminate the first parameter
to
_open3(), but this would add more code than it removes, so doesn't seem
wise.
M ext/IPC-Open2/lib/IPC/Open2.pm
M ext/IPC-Open3/lib/IPC/Open3.pm
commit 9f3ee5ee9bc539518437e56340843b97afc63320
Author: Nicholas Clark <n...@ccl4.org>
Date: Sun Jun 5 19:47:32 2011 +0200
IPC::Open3::open3() couldn't duplicate numeric file descriptors on Windows.
M ext/IPC-Open3/lib/IPC/Open3.pm
M ext/IPC-Open3/t/fd.t
M pod/perldelta.pod
commit 4a7f5a626835258b740c432e3a607b06a429ed33
Author: Nicholas Clark <n...@ccl4.org>
Date: Sun Jun 5 16:31:02 2011 +0200
Avoid an uninitialized hash key in IPC::Open::spawn_with_handles().
M ext/IPC-Open3/lib/IPC/Open3.pm
M ext/IPC-Open3/t/fd.t
commit 031f91ce84f46612589c760c55adb30af25b87b5
Author: Nicholas Clark <n...@ccl4.org>
Date: Sun Jun 5 15:58:39 2011 +0200
IPC::Open3::open3() shouldn't fail if any of *STD{IN,OUT,ERR} are localized.
Previously it would fail on Win32, because spawn_with_handles() would
attempt
to duplicate all three, ignoring failures at this point, but then report
failure to close any as a fatal error, even if this was because the earlier
dup-ing had failed.
Also avoid a warning in the *nix code path in open3() if STDERR is localized
(and hence fileno STDERR is undefined).
M ext/IPC-Open3/lib/IPC/Open3.pm
M ext/IPC-Open3/t/IPC-Open3.t
M pod/perldelta.pod
commit f598f6deabaea2ddb1fe1242577961f817614c8b
Author: Nicholas Clark <n...@ccl4.org>
Date: Sun Jun 5 15:01:13 2011 +0200
Add debug code to test IPC::Open3::spawn_with_handles() on *nix.
This allows testing of the (normally) Win32 and OS/2 specific code paths in
IPC::Open3::open3().
M ext/IPC-Open3/lib/IPC/Open3.pm
commit 1ede20e6f8f8e8421610e16743bfed46dc90efb0
Author: Nicholas Clark <n...@ccl4.org>
Date: Mon Jun 6 22:45:46 2011 +0200
In IPC::Open3::_open(), use 3 argument open to avoid a special case for
STDERR.
The code for STDIN and STDOUT never ends up needing to duplicate a
reference.
The code for STDERR can, because of the earlier special case code to save
STDOUT. It was special-cased to use fileno in commit 8b3e92c60014b4e7, in
1998.
This was before 3 argument open. With 3 argument open the special case can
be
avoided.
M ext/IPC-Open3/lib/IPC/Open3.pm
commit ea87ae30b28ea730a13b7888089b708bdb0f0991
Author: Nicholas Clark <n...@ccl4.org>
Date: Mon Jun 6 16:16:37 2011 +0200
Generalise IPC::Open3::xopen() to $n-argument open.
Previously it could only perform 2 argument open.
M ext/IPC-Open3/lib/IPC/Open3.pm
commit 8025b67f4a91c89c84e9425f55ca42755a7d5530
Author: Nicholas Clark <n...@ccl4.org>
Date: Sun Jun 5 17:06:14 2011 +0200
Simplify the test for IPC::Open bug RT #72016.
The original bug was a request that errors be reported in the parent
process,
with a TODO test, and then a patch that added the feature for the !DO_SPAWN
case, and removed the TODO. The *implication* of the bug report and the way
the
original test was only TODO for the !DO_SPAWN case was that errors were
reported inconsistently between the two code paths of open3().
However, this is not the case - the DO_SPAWN path through open3() return a
(pseudo) PID (and no error) when asked to run a non-existent program. Hence
there is now a feature discrepancy between the alternative implementations,
which feels like a bug that should (ultimately) be addressed.
The original test could have expressed that more directly with one code path
and a TODO. The refactoring of bd29e8c290c68f4f failed to spot this, and
introduced new logic errors in the DO_SPAWN path - waitpid() should not be
called if $@ is set.
Set $pid outside the eval {} - this makes sure it is (re)set to undef if the
eval fails, instead of holding its previous (now bogus) value.
M ext/IPC-Open3/t/IPC-Open3.t
-----------------------------------------------------------------------
Summary of changes:
ext/IPC-Open2/lib/IPC/Open2.pm | 5 +-
ext/IPC-Open3/lib/IPC/Open3.pm | 232 +++++++++++++++++++---------------------
ext/IPC-Open3/t/IPC-Open3.t | 43 ++++++--
ext/IPC-Open3/t/fd.t | 28 ++++--
pod/perldelta.pod | 17 +++
5 files changed, 184 insertions(+), 141 deletions(-)
diff --git a/ext/IPC-Open2/lib/IPC/Open2.pm b/ext/IPC-Open2/lib/IPC/Open2.pm
index 5f555bc..9e27144 100644
--- a/ext/IPC-Open2/lib/IPC/Open2.pm
+++ b/ext/IPC-Open2/lib/IPC/Open2.pm
@@ -6,7 +6,7 @@ our ($VERSION, @ISA, @EXPORT);
require 5.000;
require Exporter;
-$VERSION = 1.03;
+$VERSION = 1.04;
@ISA = qw(Exporter);
@EXPORT = qw(open2);
@@ -114,8 +114,7 @@ require IPC::Open3;
sub open2 {
local $Carp::CarpLevel = $Carp::CarpLevel + 1;
- return IPC::Open3::_open3('open2', scalar caller,
- $_[1], $_[0], '>&STDERR', @_[2 .. $#_]);
+ return IPC::Open3::_open3('open2', $_[1], $_[0], '>&STDERR', @_[2 .. $#_]);
}
1
diff --git a/ext/IPC-Open3/lib/IPC/Open3.pm b/ext/IPC-Open3/lib/IPC/Open3.pm
index cdd47c3..8b9fd56 100644
--- a/ext/IPC-Open3/lib/IPC/Open3.pm
+++ b/ext/IPC-Open3/lib/IPC/Open3.pm
@@ -9,7 +9,7 @@ require Exporter;
use Carp;
use Symbol qw(gensym qualify);
-$VERSION = '1.10';
+$VERSION = '1.11';
@ISA = qw(Exporter);
@EXPORT = qw(open3);
@@ -149,33 +149,17 @@ our $Me = 'open3 (bug)'; # you should never see this,
it's always localized
# 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: $!";
}
-sub xpipe_anon {
- pipe $_[0], $_[1] or croak "$Me: pipe failed: $!";
-}
-
-sub xclose_on_exec {
- require Fcntl;
- my $flags = fcntl($_[0], &Fcntl::F_GETFD, 0)
- or croak "$Me: fcntl failed: $!";
- fcntl($_[0], &Fcntl::F_SETFD, $flags|&Fcntl::FD_CLOEXEC)
- or croak "$Me: fcntl failed: $!";
-}
-
# I tried using a * prototype character for the filehandle but it still
# disallows a bareword while compiling under strict subs.
sub xopen {
- open $_[0], $_[1] or croak "$Me: open($_[0], $_[1]) failed: $!";
+ open $_[0], $_[1], @_[2..$#_] and return;
+ local $" = ', ';
+ carp "$Me: open(@_) failed: $!";
}
sub xclose {
@@ -183,33 +167,24 @@ sub xclose {
or croak "$Me: close($_[0]) failed: $!";
}
-sub fh_is_fd {
- return $_[0] =~ /\A=?(\d+)\z/;
-}
-
sub xfileno {
return $1 if $_[0] =~ /\A=?(\d+)\z/; # deal with fh just being an fd
return fileno $_[0];
}
-use constant DO_SPAWN => $^O eq 'os2' || $^O eq 'MSWin32';
+use constant FORCE_DEBUG_SPAWN => 0;
+use constant DO_SPAWN => $^O eq 'os2' || $^O eq 'MSWin32' || FORCE_DEBUG_SPAWN;
sub _open3 {
local $Me = shift;
- my($package, $dad_wtr, $dad_rdr, $dad_err, @cmd) = @_;
- my($dup_wtr, $dup_rdr, $dup_err, $kidpid);
-
- if (@cmd > 1 and $cmd[0] eq '-') {
- croak "Arguments don't make sense when the command is '-'"
- }
# simulate autovivification of filehandles because
# it's too ugly to use @_ throughout to make perl do it for us
# tchrist 5-Mar-00
unless (eval {
- $dad_wtr = $_[1] = gensym unless defined $dad_wtr && length $dad_wtr;
- $dad_rdr = $_[2] = gensym unless defined $dad_rdr && length $dad_rdr;
+ $_[0] = gensym unless defined $_[0] && length $_[0];
+ $_[1] = gensym unless defined $_[1] && length $_[1];
1; })
{
# must strip crud for croak to add back, or looks ugly
@@ -217,30 +192,48 @@ sub _open3 {
croak "$Me: $@";
}
- $dad_err ||= $dad_rdr;
+ my @handles = ({ mode => '<', handle => \*STDIN },
+ { mode => '>', handle => \*STDOUT },
+ { mode => '>', handle => \*STDERR },
+ );
+
+ foreach (@handles) {
+ $_->{parent} = shift;
+ $_->{open_as} = gensym;
+ }
+
+ if (@_ > 1 and $_[0] eq '-') {
+ croak "Arguments don't make sense when the command is '-'"
+ }
- $dup_wtr = ($dad_wtr =~ s/^[<>]&//);
- $dup_rdr = ($dad_rdr =~ s/^[<>]&//);
- $dup_err = ($dad_err =~ s/^[<>]&//);
+ $handles[2]{parent} ||= $handles[1]{parent};
+ $handles[2]{dup_of_out} = $handles[1]{parent} eq $handles[2]{parent};
- # force unqualified filehandles into caller's package
- $dad_wtr = qualify $dad_wtr, $package unless fh_is_fd($dad_wtr);
- $dad_rdr = qualify $dad_rdr, $package unless fh_is_fd($dad_rdr);
- $dad_err = qualify $dad_err, $package unless fh_is_fd($dad_err);
+ my $package;
+ foreach (@handles) {
+ $_->{dup} = ($_->{parent} =~ s/^[<>]&//);
- my $kid_rdr = gensym;
- my $kid_wtr = gensym;
- my $kid_err = gensym;
+ if ($_->{parent} !~ /\A=?(\d+)\z/) {
+ # force unqualified filehandles into caller's package
+ $package //= caller 1;
+ $_->{parent} = qualify $_->{parent}, $package;
+ }
- 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;
+ next if $_->{dup} or $_->{dup_of_out};
+ if ($_->{mode} eq '<') {
+ xpipe $_->{open_as}, $_->{parent};
+ } else {
+ xpipe $_->{parent}, $_->{open_as};
+ }
+ }
+ my $kidpid;
if (!DO_SPAWN) {
# Used to communicate exec failures.
xpipe my $stat_r, my $stat_w;
- $kidpid = xfork;
+ $kidpid = fork;
+ croak "$Me: fork failed: $!" unless defined $kidpid;
if ($kidpid == 0) { # Kid
eval {
# A tie in the parent should not be allowed to cause problems.
@@ -248,47 +241,38 @@ sub _open3 {
untie *STDOUT;
close $stat_r;
- xclose_on_exec $stat_w;
+ require Fcntl;
+ my $flags = fcntl $stat_w, &Fcntl::F_GETFD, 0;
+ croak "$Me: fcntl failed: $!" unless $flags;
+ fcntl $stat_w, &Fcntl::F_SETFD, $flags|&Fcntl::FD_CLOEXEC
+ or croak "$Me: fcntl failed: $!";
# 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
- && xfileno($dad_err) == fileno(STDOUT)) {
+ if (!$handles[2]{dup_of_out} && $handles[2]{dup}
+ && xfileno($handles[2]{parent}) == fileno \*STDOUT) {
my $tmp = gensym;
- xopen($tmp, ">&$dad_err");
- $dad_err = $tmp;
+ xopen($tmp, '>&', $handles[2]{parent});
+ $handles[2]{parent} = $tmp;
}
- if ($dup_wtr) {
- xopen \*STDIN, "<&$dad_wtr" if fileno(STDIN) !=
xfileno($dad_wtr);
- } else {
- xclose $dad_wtr;
- xopen \*STDIN, "<&=" . fileno $kid_rdr;
- }
- if ($dup_rdr) {
- xopen \*STDOUT, ">&$dad_rdr" if fileno(STDOUT) !=
xfileno($dad_rdr);
- } else {
- xclose $dad_rdr;
- xopen \*STDOUT, ">&=" . fileno $kid_wtr;
- }
- if ($dad_rdr ne $dad_err) {
- if ($dup_err) {
- # I have to use a fileno here because in this one case
- # I'm doing a dup but the filehandle might be a
reference
- # (from the special case above).
- xopen \*STDERR, ">&" . xfileno($dad_err)
- if fileno(STDERR) != xfileno($dad_err);
+ foreach (@handles) {
+ if ($_->{dup_of_out}) {
+ xopen \*STDERR, ">&STDOUT"
+ if defined fileno STDERR && fileno STDERR != fileno
STDOUT;
+ } elsif ($_->{dup}) {
+ xopen $_->{handle}, $_->{mode} . '&', $_->{parent}
+ if fileno $_->{handle} != xfileno($_->{parent});
} else {
- xclose $dad_err;
- xopen \*STDERR, ">&=" . fileno $kid_err;
+ xclose $_->{parent};
+ xopen $_->{handle}, $_->{mode} . '&=',
+ fileno $_->{open_as};
}
- } else {
- xopen \*STDERR, ">&STDOUT" if fileno(STDERR) !=
fileno(STDOUT);
}
- return 0 if ($cmd[0] eq '-');
- exec @cmd or do {
+ return 0 if ($_[0] eq '-');
+ exec @_ or do {
local($")=(" ");
- croak "$Me: exec of @cmd failed";
+ croak "$Me: exec of @_ failed";
};
};
@@ -323,52 +307,35 @@ sub _open3 {
# handled in spawn_with_handles.
my @close;
- if ($dup_wtr) {
- $kid_rdr = \*{$dad_wtr};
- push @close, $kid_rdr;
- } else {
- push @close, \*{$dad_wtr}, $kid_rdr;
- }
- if ($dup_rdr) {
- $kid_wtr = \*{$dad_rdr};
- push @close, $kid_wtr;
- } else {
- push @close, \*{$dad_rdr}, $kid_wtr;
- }
- if ($dad_rdr ne $dad_err) {
- if ($dup_err) {
- $kid_err = \*{$dad_err};
- push @close, $kid_err;
+
+ foreach (@handles) {
+ if ($_->{dup_of_out}) {
+ $_->{open_as} = $handles[1]{open_as};
+ } elsif ($_->{dup}) {
+ $_->{open_as} = $_->{parent} =~ /\A[0-9]+\z/
+ ? $_->{parent} : \*{$_->{parent}};
+ push @close, $_->{open_as};
} else {
- push @close, \*{$dad_err}, $kid_err;
+ push @close, \*{$_->{parent}}, $_->{open_as};
}
- } else {
- $kid_err = $kid_wtr;
}
require IO::Pipe;
$kidpid = eval {
- spawn_with_handles( [ { mode => 'r',
- open_as => $kid_rdr,
- handle => \*STDIN },
- { mode => 'w',
- open_as => $kid_wtr,
- handle => \*STDOUT },
- { mode => 'w',
- open_as => $kid_err,
- handle => \*STDERR },
- ], \@close, @cmd);
+ spawn_with_handles(\@handles, \@close, @_);
};
die "$Me: $@" if $@;
}
- xclose $kid_rdr if !$dup_wtr;
- xclose $kid_wtr if !$dup_rdr;
- xclose $kid_err if !$dup_err && $dad_rdr ne $dad_err;
+ foreach (@handles) {
+ next if $_->{dup} or $_->{dup_of_out};
+ xclose $_->{open_as};
+ }
+
# If the write handle is a dup give it away entirely, close my copy
# of it.
- xclose $dad_wtr if $dup_wtr;
+ xclose $handles[0]{parent} if $handles[0]{dup};
- select((select($dad_wtr), $| = 1)[0]); # unbuffer pipe
+ select((select($handles[0]{parent}), $| = 1)[0]); # unbuffer pipe
$kidpid;
}
@@ -377,43 +344,68 @@ sub open3 {
local $" = ', ';
croak "open3(@_): not enough arguments";
}
- return _open3 'open3', scalar caller, @_
+ return _open3 'open3', @_
}
sub spawn_with_handles {
my $fds = shift; # Fields: handle, mode, open_as
my $close_in_child = shift;
my ($fd, $pid, @saved_fh, $saved, %saved, @errs);
- require Fcntl;
foreach $fd (@$fds) {
$fd->{tmp_copy} = IO::Handle->new_from_fd($fd->{handle}, $fd->{mode});
- $saved{fileno $fd->{handle}} = $fd->{tmp_copy};
+ $saved{fileno $fd->{handle}} = $fd->{tmp_copy} if $fd->{tmp_copy};
}
foreach $fd (@$fds) {
bless $fd->{handle}, 'IO::Handle'
unless eval { $fd->{handle}->isa('IO::Handle') } ;
# If some of handles to redirect-to coincide with handles to
# redirect, we need to use saved variants:
- $fd->{handle}->fdopen($saved{fileno $fd->{open_as}} || $fd->{open_as},
+ $fd->{handle}->fdopen(defined fileno $fd->{open_as}
+ ? $saved{fileno $fd->{open_as}} || $fd->{open_as}
+ : $fd->{open_as},
$fd->{mode});
}
unless ($^O eq 'MSWin32') {
+ require Fcntl;
# Stderr may be redirected below, so we save the err text:
foreach $fd (@$close_in_child) {
+ next unless fileno $fd;
fcntl($fd, Fcntl::F_SETFD(), 1) or push @errs, "fcntl $fd: $!"
unless $saved{fileno $fd}; # Do not close what we redirect!
}
}
unless (@errs) {
- $pid = eval { system 1, @_ }; # 1 == P_NOWAIT
+ if (FORCE_DEBUG_SPAWN) {
+ pipe my $r, my $w or die "Pipe failed: $!";
+ $pid = fork;
+ die "Fork failed: $!" unless defined $pid;
+ if (!$pid) {
+ { no warnings; exec @_ }
+ print $w 0 + $!;
+ close $w;
+ require POSIX;
+ POSIX::_exit(255);
+ }
+ close $w;
+ my $bad = <$r>;
+ if (defined $bad) {
+ $! = $bad;
+ undef $pid;
+ }
+ } else {
+ $pid = eval { system 1, @_ }; # 1 == P_NOWAIT
+ }
push @errs, "IO::Pipe: Can't spawn-NOWAIT: $!" if !$pid || $pid < 0;
}
- foreach $fd (@$fds) {
+ # Do this in reverse, so that STDERR is restored first:
+ foreach $fd (reverse @$fds) {
$fd->{handle}->fdopen($fd->{tmp_copy}, $fd->{mode});
- $fd->{tmp_copy}->close or croak "Can't close: $!";
+ }
+ foreach (values %saved) {
+ $_->close or croak "Can't close: $!";
}
croak join "\n", @errs if @errs;
return $pid;
diff --git a/ext/IPC-Open3/t/IPC-Open3.t b/ext/IPC-Open3/t/IPC-Open3.t
index 09c44d7..0ecb841 100644
--- a/ext/IPC-Open3/t/IPC-Open3.t
+++ b/ext/IPC-Open3/t/IPC-Open3.t
@@ -14,7 +14,7 @@ BEGIN {
}
use strict;
-use Test::More tests => 25;
+use Test::More tests => 37;
use IO::Handle;
use IPC::Open3;
@@ -133,7 +133,7 @@ EOF
# for understanding of Config{'sh'} test see exec description in camel book
my $cmd = 'print(scalar(<STDIN>))';
$cmd = $Config{'sh'} =~ /sh/ ? "'$cmd'" : cmd_line($cmd);
-eval{$pid = open3 'WRITE', '>&STDOUT', 'ERROR', "$perl -e " . $cmd; };
+$pid = eval { open3 'WRITE', '>&STDOUT', 'ERROR', "$perl -e " . $cmd; };
if ($@) {
print "error $@\n";
++$test;
@@ -147,17 +147,38 @@ else {
$TB->current_test($test);
# RT 72016
-eval{$pid = open3 'WRITE', 'READ', 'ERROR', '/non/existent/program'; };
-if (IPC::Open3::DO_SPAWN) {
- if ($@) {
- cmp_ok(waitpid($pid, 0), '>', 0);
- } else {
- pass();
- }
-} else {
- isnt($@, '') or do {waitpid $pid, 0};
+{
+ local $::TODO = "$^O returns a pid and doesn't throw an exception"
+ if $^O eq 'MSWin32';
+ $pid = eval { open3 'WRITE', 'READ', 'ERROR', '/non/existent/program'; };
+ isnt($@, '',
+ 'open3 of a non existent program fails with an exception in the
parent')
+ or do {waitpid $pid, 0};
}
$pid = eval { open3 'WRITE', '', 'ERROR', '/non/existent/program'; };
like($@, qr/^open3: Modification of a read-only value attempted at /,
'open3 faults read-only parameters correctly') or do {waitpid $pid, 0};
+
+foreach my $handle (qw (DUMMY STDIN STDOUT STDERR)) {
+ local $::{$handle};
+ my $out = IO::Handle->new();
+ my $pid = eval {
+ local $SIG{__WARN__} = sub {
+ open my $fh, '>/dev/tty';
+ return if "@_" =~ m!^Use of uninitialized value
\$fd.*IO/Handle\.pm!;
+ print $fh "@_";
+ die @_
+ };
+ open3 undef, $out, undef, $perl, '-le', "print q _# ${handle}_"
+ };
+ is($@, '', "No errors with localised $handle");
+ cmp_ok($pid, '>', 0, "Got a pid with localised $handle");
+ if ($handle eq 'STDOUT') {
+ is(<$out>, undef, "Expected no output with localised $handle");
+ } else {
+ like(<$out>, qr/\A# $handle\r?\n\z/,
+ "Expected output with localised $handle");
+ }
+ waitpid $pid, 0;
+}
diff --git a/ext/IPC-Open3/t/fd.t b/ext/IPC-Open3/t/fd.t
index 7d4295e..354ebd1 100644
--- a/ext/IPC-Open3/t/fd.t
+++ b/ext/IPC-Open3/t/fd.t
@@ -14,7 +14,7 @@ BEGIN {
use strict;
use warnings;
-plan 2;
+plan 3;
# [perl #76474]
{
@@ -23,13 +23,27 @@ plan 2;
prog => 'open STDIN, q _Makefile_ or die $!; open3(q _<&1_, my $out,
undef, $ENV{PERLEXE}, q _-e0_)',
stderr => 1,
);
- {
- local $::TODO = "Bogus warning in IPC::Open3::spawn_with_handles"
- if $^O eq 'MSWin32';
- $stderr =~ s/(Use of uninitialized value.*Open3\.pm line \d+\.)\n//;
- is($1, undef, 'No bogus warning found');
- }
is $stderr, '',
"dup STDOUT in a child process by using its file descriptor";
}
+
+{
+ my $want = qr/\A# This Makefile is for the IPC::Open3 extension to
perl\.\r?\z/;
+ open my $fh, '<', 'Makefile' or die "Can't open MAKEFILE: $!";
+ my $have = <$fh>;
+ chomp $have;
+ like($have, $want, 'No surprises from MakeMaker');
+ close $fh;
+
+ fresh_perl_like(<<'EOP',
+use IPC::Open3;
+open FOO, 'Makefile' or die $!;
+open3('<&' . fileno FOO, my $out, undef, $ENV{PERLEXE}, '-eprint scalar
<STDIN>');
+print <$out>;
+EOP
+ $want,
+ undef,
+ 'Numeric file handles are duplicated correctly'
+ );
+}
diff --git a/pod/perldelta.pod b/pod/perldelta.pod
index 0361c58..bea7ea4 100644
--- a/pod/perldelta.pod
+++ b/pod/perldelta.pod
@@ -232,6 +232,23 @@ Fixed C<incr_parse> decoding string more correctly.
=item *
+L<IPC::Open3> has been upgraded from version 1.10 to version 1.11.
+
+=over 4
+
+=item *
+
+Fixes a bug which prevented use of open3 on Windows when *STDIN, *STDOUT or
+*STDERR had been localized.
+
+=item *
+
+Fixes a bug which prevented duplicating numeric file descriptors on Windows.
+
+=back
+
+=item *
+
L<Math::Complex> has been upgraded from version 1.56 to version 1.57.
Correct copy constructor usage.
--
Perl5 Master Repository
