From d7504df2a5d8985f2a8b04f17acff5e324572c39 Mon Sep 17 00:00:00 2001

From: Richard Leach <richardleach@users.noreply.github.com>

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ř <ppisar@redhat.com>

---

 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