[perl #17650] [PATCH] DESTROY can prevent propagation of die

[Alex Vandiver]

Heya,
  I got bitten by this bug today.  I'm not altogether satisfied by the
last and only comment on the bug, which summarizes to "but there's a
workaround, so it's not perl's fault!"
  Attached is a patch which restores $@ after any DESTROY blocks have
run.
 - Alex

-- 
Networking -- only one letter away from not working

diff -ru perl-current/pp_ctl.c perl-patched/pp_ctl.c
--- perl-current/pp_ctl.c	2005-07-08 13:03:02.000000000 -0400
+++ perl-patched/pp_ctl.c	2005-07-08 15:39:59.000000000 -0400
@@ -1432,6 +1432,7 @@
 	    else {
 		sv_setpvn(ERRSV, message, msglen);
 	    }
+	    message = SvPV_const(ERRSV, msglen);
 	}
 
 	while ((cxix = dopoptoeval(cxstack_ix)) < 0
@@ -1471,6 +1472,12 @@
 	     * minimal fix --GSAR */
 	    PL_curcop = cx->blk_oldcop;
 
+	    /* Leaving the block could run DESTROY blocks which might
+	     * have altered $@; reset it here just in case */
+	    if (message) {
+		sv_setpvn(ERRSV, message, msglen);
+	    }
+
 	    if (optype == OP_REQUIRE) {
                 const char* msg = SvPVx_nolen_const(ERRSV);
 		SV * const nsv = cx->blk_eval.old_namesv;
diff -ru perl-current/t/op/die.t perl-patched/t/op/die.t
--- perl-current/t/op/die.t	2005-07-06 16:38:38.000000000 -0400
+++ perl-patched/t/op/die.t	2005-07-08 15:42:12.000000000 -0400
@@ -1,6 +1,6 @@
 #!./perl
 
-print "1..15\n";
+print "1..16\n";
 
 $SIG{__DIE__} = sub { print ref($_[0]) ? ("ok ",$_[0]->[0]++,"\n") : @_ } ;
 
@@ -72,3 +72,27 @@
     print "not " unless $ok;
     print "ok 15\n";
 }
+
+# [perl #17650] DESTROY can unset $@
+{
+  package SomeClass;
+
+  sub new {
+    my $self = {};
+    bless $self;
+  }
+
+  sub DESTROY {
+    eval { 1; };
+  }
+}
+
+{
+  local $SIG{__DIE__};
+  eval {
+    my $x = new SomeClass;
+    die;
+  };
+  print($@ ? "ok 16\n" : "not ok 16\n");
+}
+