diff options
| author | Richard Leach <richardleach@users.noreply.github.com> | 2020-10-20 18:16:38 +0100 |
|---|---|---|
| committer | Tony Cook <tony@develop-help.com> | 2020-11-16 10:20:42 +1100 |
| commit | ab307de390c3459badcc89b3d77542b5b871b2e8 (patch) | |
| tree | 9c0b831697579690184eacd75fb3d8543e6d36c5 | |
| parent | 607eaf26a99ff76ab48877e68f1d7b005dc51575 (diff) | |
| download | perl-ab307de390c3459badcc89b3d77542b5b871b2e8.tar.gz | |
pp_split: add TonyC's stack-not-refcounted-suggestion and tests
| -rw-r--r-- | pp.c | 5 | ||||
| -rw-r--r-- | t/op/split.t | 5 |
2 files changed, 9 insertions, 1 deletions
@@ -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) { diff --git a/t/op/split.t b/t/op/split.t index 1d78a45bde..7a321645ac 100644 --- a/t/op/split.t +++ b/t/op/split.t @@ -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'); |