use Carp;
use Symbol qw(gensym qualify);
-$VERSION = '1.18';
+$VERSION = '1.19';
@ISA = qw(Exporter);
@EXPORT = qw(open3);
} else {
$pid = eval { system 1, @_ }; # 1 == P_NOWAIT
}
- push @errs, "IO::Pipe: Can't spawn-NOWAIT: $!" if !$pid || $pid < 0;
+ if($@) {
+ push @errs, "IO::Pipe: Can't spawn-NOWAIT: $@";
+ } elsif(!$pid || $pid < 0) {
+ push @errs, "IO::Pipe: Can't spawn-NOWAIT: $!";
+ }
}
# Do this in reverse, so that STDERR is restored first:
}
use strict;
-use Test::More tests => 44;
+use Test::More tests => 45;
use IO::Handle;
use IPC::Open3;
like($@, qr/^open3: Modification of a read-only value attempted at /,
'open3 faults read-only parameters correctly') or do {waitpid $pid, 0};
+package NoFetch;
+
+my $fetchcount = 1;
+
+sub TIESCALAR {
+ my $class = shift;
+ my $instance = shift || undef;
+ return bless \$instance => $class;
+}
+
+sub FETCH {
+ my $cmd; #dont let "@args = @DB::args;" in Carp::caller_info fire this die
+ #fetchcount may need to be increased to 2 if this code is being stepped with
+ #a perl debugger
+ if($fetchcount == 1 && (caller(1))[3] ne 'Carp::caller_info') {
+ #Carp croak reports the errors as being in IPC-Open3.t, so it is
+ #unacceptable for testing where the FETCH failure occured, we dont want
+ #it failing in a $foo = $_[0]; #later# system($foo), where the failure
+ #is supposed to be triggered in the inner most syscall, aka system()
+ my ($package, $filename, $line, $subroutine) = caller(2);
+
+ die("FETCH not allowed in ".((caller(1))[3])." in ".((caller(2))[3])."\n");
+ } else {
+ $fetchcount++;
+ return tie($cmd, 'NoFetch');
+ }
+}
+
+package main;
+
+{
+ my $cmd;
+ tie($cmd, 'NoFetch');
+
+ $pid = eval { open3 'WRITE', 'READ', 'ERROR', $cmd; };
+ like($@, qr/^(?:open3: IO::Pipe: Can't spawn-NOWAIT: FETCH not allowed in \(eval\) (?x:
+ )in IPC::Open3::spawn_with_handles|FETCH not allowed in \(eval\) in IPC::Open3::_open3)/,
+ 'dieing inside Tied arg propagates correctly') or do {waitpid $pid, 0};
+}
+
foreach my $handle (qw (DUMMY STDIN STDOUT STDERR)) {
local $::{$handle};
my $out = IO::Handle->new();
=item *
-L<XXX> has been upgraded from version A.xx to B.yy.
+L<IPC::Open3> has been upgraded from version 1.18 to 1.19.
+
+If a Perl exception was thrown from inside this module, the exception
+C<IPC::Open3> threw to the callers of C<open3> would have an irrelavent
+message derived from C<$!> which was in an undefined state, instead of the
+C<$@> message which triggers the failure path inside C<open3>.
=back