From d7504df2a5d8985f2a8b04f17acff5e324572c39 Mon Sep 17 00:00:00 2001 From: Richard Leach Date: Sun, 11 Oct 2020 12:26:27 +0100 Subject: [PATCH] pp_split: no SWITCHSTACK in @ary = split(...) optimisation MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Petr Písař: 607eaf26a99ff76ab48877e68f1d7b005dc51575 ported to 5.32.0. Signed-off-by: Petr Písař --- pp.c | 89 +++++++++++++++++++++++++++++----------------------- t/op/split.t | 23 +++++++++++++- 2 files changed, 72 insertions(+), 40 deletions(-) diff --git a/pp.c b/pp.c index df80830..e4863d3 100644 --- a/pp.c +++ b/pp.c @@ -5985,6 +5985,7 @@ PP(pp_split) /* handle @ary = split(...) optimisation */ if (PL_op->op_private & OPpSPLIT_ASSIGN) { + realarray = 1; if (!(PL_op->op_flags & OPf_STACKED)) { if (PL_op->op_private & OPpSPLIT_LEX) { if (PL_op->op_private & OPpLVAL_INTRO) @@ -6007,26 +6008,10 @@ PP(pp_split) oldsave = PL_savestack_ix; } - realarray = 1; - PUTBACK; - av_extend(ary,0); - (void)sv_2mortal(SvREFCNT_inc_simple_NN(sv)); - av_clear(ary); - SPAGAIN; if ((mg = SvTIED_mg((const SV *)ary, PERL_MAGIC_tied))) { PUSHMARK(SP); XPUSHs(SvTIED_obj(MUTABLE_SV(ary), mg)); - } - else { - if (!AvREAL(ary)) { - I32 i; - AvREAL_on(ary); - AvREIFY_off(ary); - for (i = AvFILLp(ary); i >= 0; i--) - AvARRAY(ary)[i] = &PL_sv_undef; /* don't free mere refs */ - } - /* temporarily switch stacks */ - SAVESWITCHSTACK(PL_curstack, ary); + } else { make_mortal = 0; } } @@ -6358,29 +6343,56 @@ PP(pp_split) LEAVE_SCOPE(oldsave); /* may undo an earlier SWITCHSTACK */ SPAGAIN; if (realarray) { - if (!mg) { - if (SvSMAGICAL(ary)) { - PUTBACK; + if (!mg) { + PUTBACK; + if(AvREAL(ary)) { + if (av_count(ary) > 0) + av_clear(ary); + } else { + AvREAL_on(ary); + AvREIFY_off(ary); + + if (AvMAX(ary) > -1) { + /* don't free mere refs */ + Zero(AvARRAY(ary), AvMAX(ary), SV*); + } + } + if(AvMAX(ary) < iters) + av_extend(ary,iters); + SPAGAIN; + + /* Need to copy the SV*s from the stack into ary */ + Copy(SP + 1 - iters, AvARRAY(ary), iters, SV*); + AvFILLp(ary) = iters - 1; + + if (SvSMAGICAL(ary)) { + PUTBACK; mg_set(MUTABLE_SV(ary)); SPAGAIN; - } - if (gimme == G_ARRAY) { - EXTEND(SP, iters); - Copy(AvARRAY(ary), SP + 1, iters, SV*); - SP += iters; - RETURN; - } + } + + if (gimme != G_ARRAY) { + /* SP points to the final SV* pushed to the stack. But the SV* */ + /* are not going to be used from the stack. Point SP to below */ + /* the first of these SV*. */ + SP -= iters; + PUTBACK; + } } else { - PUTBACK; - ENTER_with_name("call_PUSH"); - call_sv(SV_CONST(PUSH),G_SCALAR|G_DISCARD|G_METHOD_NAMED); - LEAVE_with_name("call_PUSH"); - SPAGAIN; + PUTBACK; + av_extend(ary,iters); + av_clear(ary); + + ENTER_with_name("call_PUSH"); + call_sv(SV_CONST(PUSH),G_SCALAR|G_DISCARD|G_METHOD_NAMED); + LEAVE_with_name("call_PUSH"); + SPAGAIN; + if (gimme == G_ARRAY) { SSize_t i; /* EXTEND should not be needed - we just popped them */ - EXTEND(SP, iters); + EXTEND_SKIP(SP, iters); for (i=0; i < iters; i++) { SV **svp = av_fetch(ary, i, FALSE); PUSHs((svp) ? *svp : &PL_sv_undef); @@ -6389,13 +6401,12 @@ PP(pp_split) } } } - else { - if (gimme == G_ARRAY) - RETURN; - } - GETTARGET; - XPUSHi(iters); + if (gimme != G_ARRAY) { + GETTARGET; + XPUSHi(iters); + } + RETURN; } diff --git a/t/op/split.t b/t/op/split.t index 14f9158..7f37512 100644 --- a/t/op/split.t +++ b/t/op/split.t @@ -7,7 +7,7 @@ BEGIN { set_up_inc('../lib'); } -plan tests => 176; +plan tests => 182; $FS = ':'; @@ -648,6 +648,19 @@ is "@a", '1 2 3', 'assignment to split-to-array (stacked)'; is (+@a, 0, "empty utf8 string"); } +# correct stack adjustments (gh#18232) +{ + sub foo { return @_ } + my @a = foo(1, scalar split " ", "a b"); + is(join('', @a), "12", "Scalar split to a sub parameter"); +} + +{ + sub foo { return @_ } + my @a = foo(1, scalar(@x = split " ", "a b")); + is(join('', @a), "12", "Split to @x then use scalar result as a sub parameter"); +} + fresh_perl_is(<<'CODE', '', {}, "scalar split stack overflow"); map{int"";split//.0>60for"0000000000000000"}split// for"00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000" CODE @@ -667,3 +680,11 @@ CODE ok(eq_array(\@result,['a','b']), "Resulting in ('a','b')"); } } + +# check that the (@ary = split) optimisation survives @ary being modified + +fresh_perl_is('my @ary; @ary = split(/\w(?{ @ary[1000] = 1 })/, "abc");', + '',{},'(@ary = split ...) survives @ary being Renew()ed'); +fresh_perl_is('my @ary; @ary = split(/\w(?{ undef @ary })/, "abc");', + '',{},'(@ary = split ...) survives an (undef @ary)'); + -- 2.25.4