diff options
author | Nicolas R <atoomic@cpan.org> | 2020-08-14 16:16:22 -0500 |
---|---|---|
committer | Steve Hay <steve.m.hay@googlemail.com> | 2021-01-06 17:39:38 +0000 |
commit | 6e48dfa8fc63a182a49aa7d935956f6d77d00e6b (patch) | |
tree | da3858d1c11d87b13eb2b67548a5175177940b92 | |
parent | b802abc5f61d1342b480ab2dcad2eb9f8d28ca43 (diff) | |
download | perl-6e48dfa8fc63a182a49aa7d935956f6d77d00e6b.tar.gz |
die_unwind(): global destruction
Fix #18063
During global destruction make sure we preserve
the string by using mortalcopy.
This is an update on 8c86f0238ecb5f32c2e7fba36e3edfdb54069068
change which avoided sv_mortalcopy in favor of sv_2mortal.
(cherry picked from commit 042abef72d40ab7ff39127e2afae6e34dfc66404)
-rw-r--r-- | pp_ctl.c | 6 | ||||
-rw-r--r-- | t/op/die_unwind.t | 4 |
2 files changed, 9 insertions, 1 deletions
@@ -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(); |