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.

2 files changed, 29 insertions, 2 deletions

diff --git a/dist/Safe/Safe.pm b/dist/Safe/Safe.pm
index fd628deda8..7453f245a9 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 5ba26859c8..71d9a94fde 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';
+