|
 |
2b720e2 |
From 042abef72d40ab7ff39127e2afae6e34dfc66404 Mon Sep 17 00:00:00 2001
|
|
|
2b720e2 |
From: Nicolas R <atoomic@cpan.org>
|
|
|
2b720e2 |
Date: Fri, 14 Aug 2020 16:16:22 -0500
|
|
|
2b720e2 |
Subject: [PATCH] die_unwind(): global destruction
|
|
|
2b720e2 |
MIME-Version: 1.0
|
|
|
2b720e2 |
Content-Type: text/plain; charset=UTF-8
|
|
|
2b720e2 |
Content-Transfer-Encoding: 8bit
|
|
|
2b720e2 |
|
|
|
2b720e2 |
Fix #18063
|
|
|
2b720e2 |
|
|
|
2b720e2 |
During global destruction make sure we preserve
|
|
|
2b720e2 |
the string by using mortalcopy.
|
|
|
2b720e2 |
|
|
|
2b720e2 |
This is an update on 8c86f0238ecb5f32c2e7fba36e3edfdb54069068
|
|
|
2b720e2 |
change which avoided sv_mortalcopy in favor of sv_2mortal.
|
|
|
2b720e2 |
|
|
|
2b720e2 |
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
|
|
2b720e2 |
---
|
|
|
2b720e2 |
pp_ctl.c | 6 +++++-
|
|
|
2b720e2 |
t/op/die_unwind.t | 4 ++++
|
|
|
2b720e2 |
2 files changed, 9 insertions(+), 1 deletion(-)
|
|
|
2b720e2 |
|
|
|
2b720e2 |
diff --git a/pp_ctl.c b/pp_ctl.c
|
|
|
2b720e2 |
index b8cd869ee0..cc244d7ba7 100644
|
|
|
2b720e2 |
--- a/pp_ctl.c
|
|
|
2b720e2 |
+++ b/pp_ctl.c
|
|
|
2b720e2 |
@@ -1716,7 +1716,11 @@ Perl_die_unwind(pTHX_ SV *msv)
|
|
|
2b720e2 |
* when unlocalising a tied var). So we do a dance with
|
|
|
2b720e2 |
* mortalising and SAVEFREEing.
|
|
|
2b720e2 |
*/
|
|
|
2b720e2 |
- sv_2mortal(SvREFCNT_inc_simple_NN(exceptsv));
|
|
|
2b720e2 |
+ if (PL_phase == PERL_PHASE_DESTRUCT) {
|
|
|
2b720e2 |
+ exceptsv = sv_mortalcopy(exceptsv);
|
|
|
2b720e2 |
+ } else {
|
|
|
2b720e2 |
+ exceptsv = sv_2mortal(SvREFCNT_inc_simple_NN(exceptsv));
|
|
|
2b720e2 |
+ }
|
|
|
2b720e2 |
|
|
|
2b720e2 |
/*
|
|
|
2b720e2 |
* Historically, perl used to set ERRSV ($@) early in the die
|
|
|
2b720e2 |
diff --git a/t/op/die_unwind.t b/t/op/die_unwind.t
|
|
|
2b720e2 |
index eee1ce534b..4b83ee6fac 100644
|
|
|
2b720e2 |
--- a/t/op/die_unwind.t
|
|
|
2b720e2 |
+++ b/t/op/die_unwind.t
|
|
|
2b720e2 |
@@ -69,4 +69,8 @@ is($uerr, "t3\n");
|
|
|
2b720e2 |
is($val, undef, "undefined return value from 'eval' block with 'die'");
|
|
|
2b720e2 |
is($err, "t3\n");
|
|
|
2b720e2 |
|
|
|
2b720e2 |
+fresh_perl_like(<<'EOS', qr/Custom Message During Global Destruction/, { switches => ['-w'], stderr => 1 } );
|
|
|
2b720e2 |
+package Foo; sub DESTROY { die "Custom Message During Global Destruction" }; package main; our $wut = bless [], "Foo"
|
|
|
2b720e2 |
+EOS
|
|
|
2b720e2 |
+
|
|
|
2b720e2 |
done_testing();
|
|
|
2b720e2 |
--
|
|
|
2b720e2 |
2.25.4
|
|
|
2b720e2 |
|