This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
make pp_goto() cope potential stack reallocation in EXTEND
authorDave Mitchell <davem@fdisolutions.com>
Sat, 14 Aug 2004 22:32:16 +0000 (22:32 +0000)
committerDave Mitchell <davem@fdisolutions.com>
Sat, 14 Aug 2004 22:32:16 +0000 (22:32 +0000)
The code for goto &foo had local pointers to the stack that
pointed to the wrong place after a realloc.

p4raw-id: //depot/perl@23217

pp_ctl.c
t/op/goto.t

index 4ba1171..f07d716 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -2267,16 +2267,13 @@ PP(pp_goto)
            TOPBLOCK(cx);
            if (CxREALEVAL(cx))
                DIE(aTHX_ "Can't goto subroutine from an eval-string");
-           mark = PL_stack_sp;
            if (CxTYPE(cx) == CXt_SUB && cx->blk_sub.hasargs) {
                /* put @_ back onto stack */
                AV* av = cx->blk_sub.argarray;
                
                items = AvFILLp(av) + 1;
-               PL_stack_sp++;
-               EXTEND(PL_stack_sp, items); /* @_ could have been extended. */
-               Copy(AvARRAY(av), PL_stack_sp, items, SV*);
-               PL_stack_sp += items;
+               EXTEND(SP, items+1); /* @_ could have been extended. */
+               Copy(AvARRAY(av), SP + 1, items, SV*);
                SvREFCNT_dec(GvAV(PL_defgv));
                GvAV(PL_defgv) = cx->blk_sub.savearray;
                /* abandon @_ if it got reified */
@@ -2294,11 +2291,11 @@ PP(pp_goto)
                AV* av;
                av = GvAV(PL_defgv);
                items = AvFILLp(av) + 1;
-               PL_stack_sp++;
-               EXTEND(PL_stack_sp, items); /* @_ could have been extended. */
-               Copy(AvARRAY(av), PL_stack_sp, items, SV*);
-               PL_stack_sp += items;
+               EXTEND(SP, items+1); /* @_ could have been extended. */
+               Copy(AvARRAY(av), SP + 1, items, SV*);
            }
+           mark = SP;
+           SP += items;
            if (CxTYPE(cx) == CXt_SUB &&
                !(CvDEPTH(cx->blk_sub.cv) = cx->blk_sub.olddepth))
                SvREFCNT_dec(cx->blk_sub.cv);
@@ -2331,9 +2328,9 @@ PP(pp_goto)
                    SV **newsp;
                    I32 gimme;
 
-                   PL_stack_sp--;              /* There is no cv arg. */
                    /* Push a mark for the start of arglist */
                    PUSHMARK(mark);
+                   PUTBACK;
                    (void)(*CvXSUB(cv))(aTHX_ cv);
                    /* Pop the current context like a decent sub should */
                    POPBLOCK(cx, PL_curpm);
@@ -2372,7 +2369,6 @@ PP(pp_goto)
                    GvAV(PL_defgv) = (AV*)SvREFCNT_inc(av);
                    CX_CURPAD_SAVE(cx->blk_sub);
                    cx->blk_sub.argarray = av;
-                   ++mark;
 
                    if (items >= AvMAX(av) + 1) {
                        ary = AvALLOC(av);
@@ -2387,6 +2383,7 @@ PP(pp_goto)
                            SvPVX(av) = (char*)ary;
                        }
                    }
+                   ++mark;
                    Copy(mark,AvARRAY(av),items,SV*);
                    AvFILLp(av) = items - 1;
                    assert(!AvREAL(av));
index b948630..c0936a7 100755 (executable)
@@ -7,7 +7,7 @@ BEGIN {
     @INC = qw(. ../lib);
 }
 
-print "1..45\n";
+print "1..46\n";
 
 require "test.pl";
 
@@ -393,3 +393,18 @@ moretests:
     }
 }
 
+# deep recursion with gotos eventually caused a stack reallocation
+# which messed up buggy internals that didn't expect the stack to move
+
+sub recurse1 {
+    unshift @_, "x";
+    goto &recurse2;
+}
+sub recurse2 {
+    $x = shift;
+    $_[0] ? +1 + recurse1($_[0] - 1) : 0
+}
+print "not " unless recurse1(500) == 500;
+print "ok 46 - recursive goto &foo\n";
+
+