LOGONLY mark e42956 as DOC but verify needed since I want somebody to check my logic...

[p5sagit/p5-mst-13.2.git] / pad.c

diff --git a/pad.c b/pad.c
index cc2ade2..e8ba139 100644 (file)
--- a/pad.c
+++ b/pad.c
@@ -200,7 +200,6 @@ Perl_pad_new(pTHX_ int flags)
         */
 
         AV * const a0 = newAV();                       /* will be @_ */
-       av_extend(a0, 0);
        av_store(pad, 0, MUTABLE_SV(a0));
        AvREIFY_only(a0);
     }
@@ -421,13 +420,13 @@ Perl_pad_add_name(pTHX_ const char *name, const STRLEN len, const U32 flags,
        PL_min_intro_pending = offset;
     PL_max_intro_pending = offset;
     /* if it's not a simple scalar, replace with an AV or HV */
-    /* XXX DAPM since slot has been allocated, replace
-     * av_store with PL_curpad[offset] ? */
+    assert(SvTYPE(PL_curpad[offset]) == SVt_NULL);
+    assert(SvREFCNT(PL_curpad[offset]) == 1);
     if (*name == '@')
-       av_store(PL_comppad, offset, MUTABLE_SV(newAV()));
+       sv_upgrade(PL_curpad[offset], SVt_PVAV);
     else if (*name == '%')
-       av_store(PL_comppad, offset, MUTABLE_SV(newHV()));
-    SvPADMY_on(PL_curpad[offset]);
+       sv_upgrade(PL_curpad[offset], SVt_PVHV);
+    assert(SvPADMY(PL_curpad[offset]));
     DEBUG_Xv(PerlIO_printf(Perl_debug_log,
                           "Pad addname: %ld \"%s\" new lex=0x%"UVxf"\n",
                           (long)offset, name, PTR2UV(PL_curpad[offset])));
@@ -705,6 +704,28 @@ Perl_find_rundefsvoffset(pTHX)
 }
 
 /*
+ * Returns a lexical $_, if there is one, at run time ; or the global one
+ * otherwise.
+ */
+
+SV *
+Perl_find_rundefsv(pTHX)
+{
+    SV *namesv;
+    int flags;
+    PADOFFSET po;
+
+    po = pad_findlex("$_", find_runcv(NULL), PL_curcop->cop_seq, 1,
+           NULL, &namesv, &flags);
+
+    if (po == NOT_IN_PAD
+       || (SvFLAGS(namesv) & (SVpad_NAME|SVpad_OUR)) == (SVpad_NAME|SVpad_OUR))
+       return DEFSV;
+
+    return PAD_SVl(po);
+}
+
+/*
 =for apidoc pad_findlex
 
 Find a named lexical anywhere in a chain of nested pads. Add fake entries
@@ -1299,18 +1320,37 @@ Perl_pad_tidy(pTHX_ padtidy_type type)
     else if (type == padtidy_SUB) {
        /* XXX DAPM this same bit of code keeps appearing !!! Rationalise? */
        AV * const av = newAV();                        /* Will be @_ */
-       av_extend(av, 0);
        av_store(PL_comppad, 0, MUTABLE_SV(av));
        AvREIFY_only(av);
     }
 
     if (type == padtidy_SUB || type == padtidy_FORMAT) {
+       SV * const * const namep = AvARRAY(PL_comppad_name);
        PADOFFSET ix;
        for (ix = AvFILLp(PL_comppad); ix > 0; ix--) {
            if (SvIMMORTAL(PL_curpad[ix]) || IS_PADGV(PL_curpad[ix]) || IS_PADCONST(PL_curpad[ix]))
                continue;
-           if (!SvPADMY(PL_curpad[ix]))
+           if (!SvPADMY(PL_curpad[ix])) {
                SvPADTMP_on(PL_curpad[ix]);
+           } else if (!SvFAKE(namep[ix])) {
+               /* This is a work around for how the current implementation of
+                  ?{ } blocks in regexps interacts with lexicals.
+
+                  One of our lexicals.
+                  Can't do this on all lexicals, otherwise sub baz() won't
+                  compile in
+
+                  my $foo;
+
+                  sub bar { ++$foo; }
+
+                  sub baz { ++$foo; }
+
+                  because completion of compiling &bar calling pad_tidy()
+                  would cause (top level) $foo to be marked as stale, and
+                  "no longer available".  */
+               SvPADSTALE_on(PL_curpad[ix]);
+           }
        }
     }
     PL_curpad = AvARRAY(PL_comppad);
@@ -1722,7 +1762,6 @@ Perl_pad_push(pTHX_ PADLIST *padlist, int depth)
            }
        }
        av = newAV();
-       av_extend(av, 0);
        av_store(newpad, 0, MUTABLE_SV(av));
        AvREIFY_only(av);
 
@@ -1816,7 +1855,10 @@ Perl_padlist_dup(pTHX_ AV *const srcpad, CLONE_PARAMS *const param)
                            pad1a[ix] = sv_dup_inc(oldpad[ix], param);
                        }
                    else {              /* our own lexical */
-                       if(SvREFCNT(oldpad[ix]) > 1) {
+                       if(SvPADSTALE(oldpad[ix]) && SvREFCNT(oldpad[ix]) > 1) {
+                           /* This is a work around for how the current
+                              implementation of ?{ } blocks in regexps
+                              interacts with lexicals.  */
                            pad1a[ix] = sv_dup_inc(oldpad[ix], param);
                        } else {
                            SV *sv;