[perl.git] branch blead, updated. v5.11.4-78-g2630fd9

[Rafael Garcia-Suarez]

In perl.git, the branch blead has been updated

<http://perl5.git.perl.org/perl.git/commitdiff/2630fd9e8e31d2fd409e2e8ec16dc85d230a3eb3?hp=78c4a74a09b8f7ed410a879bd78dfb83cbf7861c>

- Log -----------------------------------------------------------------
commit 2630fd9e8e31d2fd409e2e8ec16dc85d230a3eb3
Author: Tim Bunce <***@pobox.com>
Date: Thu Feb 11 11:29:17 2010 +0100

Bug in Safe 2.21 re propagating exceptions

An exception thrown from a closure gets lost.
I've boiled it down to this:

perl -MSafe -e 'Safe->new->reval(q{sub { die @_ }})->(qq{ok\n})'

That should die with "ok".

The problem is that the closure that wraps any returned code ref if
threads are enabled is acting as an eval block so hiding the exception.
-----------------------------------------------------------------------

Summary of changes:
dist/Safe/Safe.pm | 16 +++++++++++++++-
dist/Safe/t/safesort.t | 15 ++++++++++++++-
2 files changed, 29 insertions(+), 2 deletions(-)

diff --git a/dist/Safe/Safe.pm b/dist/Safe/Safe.pm
index fd628de..7453f24 100644
--- a/dist/Safe/Safe.pm
+++ b/dist/Safe/Safe.pm
@@ -311,7 +311,21 @@ sub reval {
$ret = sub {
my @args = @_; # lexical to close over
my $sub_with_args = sub { $sub->(@args) };
- return Opcode::_safe_call_sv($root, $obj->{Mask}, $sub_with_args)
+
+ my @subret;
+ my $error;
+ do {
+ local $@; # needed due to perl_call_sv(sv, G_EVAL|G_KEEPERR)
+ @subret = (wantarray)
+ ? Opcode::_safe_call_sv($root, $obj->{Mask}, $sub_with_args)
+ : scalar Opcode::_safe_call_sv($root, $obj->{Mask}, $sub_with_args);
+ $error = $@;
+ };
+ if ($error) { # rethrow exception
+ $error =~ s/\t\(in cleanup\) //; # prefix added by G_KEEPERR
+ die $error;
+ }
+ return (wantarray) ? @subret : $subret[0];
};
}
}
diff --git a/dist/Safe/t/safesort.t b/dist/Safe/t/safesort.t
index 5ba2685..71d9a94 100644
--- a/dist/Safe/t/safesort.t
+++ b/dist/Safe/t/safesort.t
@@ -9,7 +9,7 @@ BEGIN {
}

use Safe 1.00;
-use Test::More tests => 6;
+use Test::More tests => 9;

my $safe = Safe->new('PLPerl');
$safe->permit_only(qw(:default sort));
@@ -36,3 +36,16 @@ is ref $func, 'CODE', 'reval should return a CODE ref';
my ($l_sorted, $p_sorted) = $func->(1,2,3);
is $l_sorted, "1,2,3";
is $p_sorted, "1,2,3";
+
+# check other aspects of closures created inside Safe
+
+my $die_func = $safe->reval(q{ sub { die @_ if @_; 1 } });
+
+# check $@ not affected by successful call
+$@ = 42;
+$die_func->();
+is $@, 42, 'successful closure call should not alter $@';
+
+ok !eval { $die_func->("died\n"); 1 }, 'should die';
+is $@, "died\n", '$@ should be set correctly';
+

--
Perl5 Master Repository

[Jerry D. Hedden]

On Thu, Feb 11, 2010 at 05:32, Rafael Garcia-Suarez

Post by Rafael Garcia-Suarez
In perl.git, the branch blead has been updated
<http://perl5.git.perl.org/perl.git/commitdiff/2630fd9e8e31d2fd409e2e8ec16dc85d230a3eb3?hp=78c4a74a09b8f7ed410a879bd78dfb83cbf7861c>
- Log -----------------------------------------------------------------
commit 2630fd9e8e31d2fd409e2e8ec16dc85d230a3eb3
Date:   Thu Feb 11 11:29:17 2010 +0100
   Bug in Safe 2.21 re propagating exceptions
   An exception thrown from a closure gets lost.
   That should die with "ok".
   The problem is that the closure that wraps any returned code ref if
   threads are enabled is acting as an eval block so hiding the exception.
-----------------------------------------------------------------------

This is causing the following anomoly in 'make test':

dist/Safe/t/safesort........................................... (in
cleanup) died
ok