summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--pp_ctl.c6
-rw-r--r--t/op/die_unwind.t4
2 files changed, 9 insertions, 1 deletions
diff --git a/pp_ctl.c b/pp_ctl.c
index c53dced86a..3797ec434e 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -1716,7 +1716,11 @@ Perl_die_unwind(pTHX_ SV *msv)
* when unlocalising a tied var). So we do a dance with
* mortalising and SAVEFREEing.
*/
- sv_2mortal(SvREFCNT_inc_simple_NN(exceptsv));
+ if (PL_phase == PERL_PHASE_DESTRUCT) {
+ exceptsv = sv_mortalcopy(exceptsv);
+ } else {
+ exceptsv = sv_2mortal(SvREFCNT_inc_simple_NN(exceptsv));
+ }
/*
* Historically, perl used to set ERRSV ($@) early in the die
diff --git a/t/op/die_unwind.t b/t/op/die_unwind.t
index eee1ce534b..4b83ee6fac 100644
--- a/t/op/die_unwind.t
+++ b/t/op/die_unwind.t
@@ -69,4 +69,8 @@ is($uerr, "t3\n");
is($val, undef, "undefined return value from 'eval' block with 'die'");
is($err, "t3\n");
+fresh_perl_like(<<'EOS', qr/Custom Message During Global Destruction/, { switches => ['-w'], stderr => 1 } );
+package Foo; sub DESTROY { die "Custom Message During Global Destruction" }; package main; our $wut = bless [], "Foo"
+EOS
+
done_testing();