On Sun, 2005-07-10 at 14:29 +0100, Dave Mitchell wrote:
> I don't think this fix is robust. You save the current PV value of ERRSV,
> and then later set it back; in the meantime, ERRSV's PV may have been
> realloced, and message now points to free or realloced garbage.
Point. The attached patch uses save_item(ERRSV) to fully localize [EMAIL
PROTECTED]
Also added more tests that the previous patch didn't pass on. Thoughts?
- Alex
--
Networking -- only one letter away from not working
diff -ru perl-current/sv.c perl-patched/sv.c
--- perl-current/sv.c 2005-07-08 13:03:02.000000000 -0400
+++ perl-patched/sv.c 2005-07-18 00:12:01.000000000 -0400
@@ -5519,6 +5519,10 @@
PUSHMARK(SP);
PUSHs(tmpref);
PUTBACK;
+
+ /* Localise $@ so DESTROY caused by die can't reset $@ */
+ save_item(ERRSV);
+
call_sv((SV*)destructor, G_DISCARD|G_EVAL|G_KEEPERR|G_VOID);
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-16 02:25:44.000000000 -0400
@@ -1,6 +1,6 @@
#!./perl
-print "1..15\n";
+print "1..17\n";
$SIG{__DIE__} = sub { print ref($_[0]) ? ("ok ",$_[0]->[0]++,"\n") : @_ } ;
@@ -72,3 +72,43 @@
print "not " unless $ok;
print "ok 15\n";
}
+
+# [perl #17650] DESTROY can unset $@
+{
+ package SomeClass;
+ sub new { return bless {}; }
+ sub DESTROY {
+ eval { 1; };
+ }
+}
+
+{
+ package SomeOtherClass;
+ sub new { return bless {}; }
+ sub DESTROY {
+ eval { die bless {}, "Moose"; }
+ }
+}
+
+{
+ local $SIG{__DIE__};
+ eval {
+ my $x = new SomeClass;
+ die;
+ };
+ print($@ ? "ok 16\n" : "not ok 16\n");
+
+ eval {
+ my $x = new SomeOtherClass;
+ die bless {}, "Thingy";
+ };
+ print($@ ? "ok 17\n" : "not ok 17\n");
+ print(ref $@ eq "Thingy" ? "ok 18\n" : "not ok 18\n");
+
+ eval {
+ my $s = new SomeOtherClass;
+ };
+ print($@ ? "not ok 19\n" : "ok 19\n");
+}
+
+
