|
 |
8446b7 |
From ab307de390c3459badcc89b3d77542b5b871b2e8 Mon Sep 17 00:00:00 2001
|
|
|
8446b7 |
From: Richard Leach <richardleach@users.noreply.github.com>
|
|
|
8446b7 |
Date: Tue, 20 Oct 2020 18:16:38 +0100
|
|
|
8446b7 |
Subject: [PATCH 2/2] pp_split: add TonyC's stack-not-refcounted-suggestion and
|
|
|
8446b7 |
tests
|
|
|
8446b7 |
MIME-Version: 1.0
|
|
|
8446b7 |
Content-Type: text/plain; charset=UTF-8
|
|
|
8446b7 |
Content-Transfer-Encoding: 8bit
|
|
|
8446b7 |
|
|
|
8446b7 |
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
|
|
8446b7 |
---
|
|
|
8446b7 |
pp.c | 5 ++++-
|
|
|
8446b7 |
t/op/split.t | 5 +++++
|
|
|
8446b7 |
2 files changed, 9 insertions(+), 1 deletion(-)
|
|
|
8446b7 |
|
|
|
8446b7 |
diff --git a/pp.c b/pp.c
|
|
|
8446b7 |
index ce16c56e63..5b5e163011 100644
|
|
|
8446b7 |
--- a/pp.c
|
|
|
8446b7 |
+++ b/pp.c
|
|
|
8446b7 |
@@ -6034,6 +6034,9 @@ PP(pp_split)
|
|
|
8446b7 |
oldsave = PL_savestack_ix;
|
|
|
8446b7 |
}
|
|
|
8446b7 |
|
|
|
8446b7 |
+ /* Some defence against stack-not-refcounted bugs */
|
|
|
8446b7 |
+ (void)sv_2mortal(SvREFCNT_inc_simple_NN(ary));
|
|
|
8446b7 |
+
|
|
|
8446b7 |
if ((mg = SvTIED_mg((const SV *)ary, PERL_MAGIC_tied))) {
|
|
|
8446b7 |
PUSHMARK(SP);
|
|
|
8446b7 |
XPUSHs(SvTIED_obj(MUTABLE_SV(ary), mg));
|
|
|
8446b7 |
@@ -6356,7 +6359,7 @@ PP(pp_split)
|
|
|
8446b7 |
}
|
|
|
8446b7 |
|
|
|
8446b7 |
PUTBACK;
|
|
|
8446b7 |
- LEAVE_SCOPE(oldsave); /* may undo an earlier SWITCHSTACK */
|
|
|
8446b7 |
+ LEAVE_SCOPE(oldsave);
|
|
|
8446b7 |
SPAGAIN;
|
|
|
8446b7 |
if (realarray) {
|
|
|
8446b7 |
if (!mg) {
|
|
|
8446b7 |
diff --git a/t/op/split.t b/t/op/split.t
|
|
|
8446b7 |
index 1d78a45bde..7a321645ac 100644
|
|
|
8446b7 |
--- a/t/op/split.t
|
|
|
8446b7 |
+++ b/t/op/split.t
|
|
|
8446b7 |
@@ -703,3 +703,8 @@ fresh_perl_is('my @ary; @ary = split(/\w(?{ @ary[1000] = 1 })/, "abc");',
|
|
|
8446b7 |
fresh_perl_is('my @ary; @ary = split(/\w(?{ undef @ary })/, "abc");',
|
|
|
8446b7 |
'',{},'(@ary = split ...) survives an (undef @ary)');
|
|
|
8446b7 |
|
|
|
8446b7 |
+# check the (@ary = split) optimisation survives stack-not-refcounted bugs
|
|
|
8446b7 |
+fresh_perl_is('our @ary; @ary = split(/\w(?{ *ary = 0 })/, "abc");',
|
|
|
8446b7 |
+ '',{},'(@ary = split ...) survives @ary destruction via typeglob');
|
|
|
8446b7 |
+fresh_perl_is('my $ary = []; @$ary = split(/\w(?{ $ary = [] })/, "abc");',
|
|
|
8446b7 |
+ '',{},'(@ary = split ...) survives @ary destruction via reassignment');
|
|
|
8446b7 |
--
|
|
|
8446b7 |
2.25.4
|
|
|
8446b7 |
|