This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
[perl #32039] Chained goto &sub drops data too early.
authorDave Mitchell <davem@fdisolutions.com>
Sat, 23 Oct 2004 21:50:19 +0000 (21:50 +0000)
committerDave Mitchell <davem@fdisolutions.com>
Sat, 23 Oct 2004 21:50:19 +0000 (21:50 +0000)
Change 22373 to stop a memory leak in goto &foo intead caused
the elements of @_ to be freed too early. This revised fix
just transfers the reifiedness of the old @_ to the new @_

p4raw-id: //depot/perl@23418

pp_ctl.c
t/op/goto.t

index 2c18cf5..4b894fc 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -2248,7 +2248,6 @@ PP(pp_goto)
     char *label;
     int do_dump = (PL_op->op_type == OP_DUMP);
     static char must_have_label[] = "goto must have label";
-    AV *oldav = Nullav;
 
     label = 0;
     if (PL_op->op_flags & OPf_STACKED) {
@@ -2263,6 +2262,7 @@ PP(pp_goto)
            SV** mark;
            I32 items = 0;
            I32 oldsave;
+           bool reified = 0;
 
        retry:
            if (!CvROOT(cv) && !CvXSUB(cv)) {
@@ -2304,16 +2304,16 @@ PP(pp_goto)
                Copy(AvARRAY(av), SP + 1, items, SV*);
                SvREFCNT_dec(GvAV(PL_defgv));
                GvAV(PL_defgv) = cx->blk_sub.savearray;
+               CLEAR_ARGARRAY(av);
                /* abandon @_ if it got reified */
                if (AvREAL(av)) {
-                   oldav = av; /* delay until return */
+                   reified = 1;
+                   SvREFCNT_dec(av);
                    av = newAV();
                    av_extend(av, items-1);
                    AvFLAGS(av) = AVf_REIFY;
                    PAD_SVl(0) = (SV*)(cx->blk_sub.argarray = av);
                }
-               else
-                   CLEAR_ARGARRAY(av);
            }
            else if (CvXSUB(cv)) {      /* put GvAV(defgv) back onto stack */
                AV* av;
@@ -2332,11 +2332,13 @@ PP(pp_goto)
 
            /* Now do some callish stuff. */
            SAVETMPS;
-           /* For reified @_, delay freeing till return from new sub */
-           if (oldav)
-               SAVEFREESV((SV*)oldav);
            SAVEFREESV(cv); /* later, undo the 'avoid premature free' hack */
            if (CvXSUB(cv)) {
+               if (reified) {
+                   I32 index;
+                   for (index=0; index<items; index++)
+                       sv_2mortal(SP[-index]);
+               }
 #ifdef PERL_XSUB_OLDSTYLE
                if (CvOLDSTYLE(cv)) {
                    I32 (*fp3)(int,int,int);
@@ -2415,6 +2417,11 @@ PP(pp_goto)
                    Copy(mark,AvARRAY(av),items,SV*);
                    AvFILLp(av) = items - 1;
                    assert(!AvREAL(av));
+                   if (reified) {
+                       /* transfer 'ownership' of refcnts to new @_ */
+                       AvREAL_on(av);
+                       AvREIFY_off(av);
+                   }
                    while (items--) {
                        if (*mark)
                            SvTEMP_off(*mark);
index c0936a7..3b92123 100755 (executable)
@@ -7,7 +7,7 @@ BEGIN {
     @INC = qw(. ../lib);
 }
 
-print "1..46\n";
+print "1..47\n";
 
 require "test.pl";
 
@@ -407,4 +407,12 @@ sub recurse2 {
 print "not " unless recurse1(500) == 500;
 print "ok 46 - recursive goto &foo\n";
 
+# [perl #32039] Chained goto &sub drops data too early. 
+
+sub a32039 { @_=("foo"); goto &b32039; }
+sub b32039 { goto &c32039; }
+sub c32039 { print $_[0] eq 'foo' ? "" : "not ", "ok 47 - chained &goto\n" }
+a32039();
+
+