From 2630fd9e8e31d2fd409e2e8ec16dc85d230a3eb3 Mon Sep 17 00:00:00 2001
From: Tim Bunce <Tim.Bunce@pobox.com>
Date: Thu, 11 Feb 2010 11:29:17 +0100
Subject: 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.
---
 dist/Safe/Safe.pm | 16 +++++++++++++++-
 1 file changed, 15 insertions(+), 1 deletion(-)

(limited to 'dist/Safe/Safe.pm')

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];
             };
         }
     }
-- 
cgit v1.2.1