This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
pp_split: add TonyC's stack-not-refcounted-suggestion and tests
authorRichard Leach <richardleach@users.noreply.github.com>
Tue, 20 Oct 2020 17:16:38 +0000 (18:16 +0100)
committerTony Cook <tony@develop-help.com>
Sun, 15 Nov 2020 23:20:42 +0000 (10:20 +1100)
pp.c
t/op/split.t

diff --git a/pp.c b/pp.c
index ce16c56..5b5e163 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -6034,6 +6034,9 @@ PP(pp_split)
             oldsave = PL_savestack_ix;
         }
 
+       /* Some defence against stack-not-refcounted bugs */
+       (void)sv_2mortal(SvREFCNT_inc_simple_NN(ary));
+
        if ((mg = SvTIED_mg((const SV *)ary, PERL_MAGIC_tied))) {
            PUSHMARK(SP);
            XPUSHs(SvTIED_obj(MUTABLE_SV(ary), mg));
@@ -6356,7 +6359,7 @@ PP(pp_split)
     }
 
     PUTBACK;
-    LEAVE_SCOPE(oldsave); /* may undo an earlier SWITCHSTACK */
+    LEAVE_SCOPE(oldsave);
     SPAGAIN;
     if (realarray) {
         if (!mg) {
index 1d78a45..7a32164 100644 (file)
@@ -703,3 +703,8 @@ fresh_perl_is('my @ary; @ary = split(/\w(?{ @ary[1000] = 1 })/, "abc");',
 fresh_perl_is('my @ary; @ary = split(/\w(?{ undef @ary })/, "abc");',
         '',{},'(@ary = split ...) survives an (undef @ary)');
 
+# check the (@ary = split) optimisation survives stack-not-refcounted bugs
+fresh_perl_is('our @ary; @ary = split(/\w(?{ *ary = 0 })/, "abc");',
+        '',{},'(@ary = split ...) survives @ary destruction via typeglob');
+fresh_perl_is('my $ary = []; @$ary = split(/\w(?{ $ary = [] })/, "abc");',
+        '',{},'(@ary = split ...) survives @ary destruction via reassignment');