For PROXYSUBS, add an option to push all constants' names onto an array.

[perl5.git] / pad.c

diff --git a/pad.c b/pad.c
index 207f475..e945113 100644 (file)
--- a/pad.c
+++ b/pad.c
@@ -132,7 +132,8 @@ For state vars, SVs_PADSTALE is overloaded to mean 'not yet initialised'
 
 #ifdef PERL_MAD
 void pad_peg(const char* s) {
-    static int pegcnt;
+    static int pegcnt; /* XXX not threadsafe */
+    PERL_UNUSED_ARG(s);
 
     PERL_ARGS_ASSERT_PAD_PEG;
 
@@ -200,7 +201,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 +421,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 +705,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 +1321,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);
@@ -1522,7 +1563,7 @@ Perl_cv_clone(pTHX_ CV *proto)
     SAVESPTR(PL_compcv);
 
     cv = PL_compcv = MUTABLE_CV(newSV_type(SvTYPE(proto)));
-    CvFLAGS(cv) = CvFLAGS(proto) & ~(CVf_CLONE|CVf_WEAKOUTSIDE);
+    CvFLAGS(cv) = CvFLAGS(proto) & ~(CVf_CLONE|CVf_WEAKOUTSIDE|CVf_CVGV_RC);
     CvCLONED_on(cv);
 
 #ifdef USE_ITHREADS
@@ -1531,8 +1572,10 @@ Perl_cv_clone(pTHX_ CV *proto)
 #else
     CvFILE(cv)         = CvFILE(proto);
 #endif
-    CvGV(cv)           = CvGV(proto);
+    CvGV_set(cv,CvGV(proto));
     CvSTASH(cv)                = CvSTASH(proto);
+    if (CvSTASH(cv))
+       Perl_sv_add_backref(aTHX_ MUTABLE_SV(CvSTASH(cv)), MUTABLE_SV(cv));
     OP_REFCNT_LOCK;
     CvROOT(cv)         = OpREFCNT_inc(CvROOT(proto));
     OP_REFCNT_UNLOCK;
@@ -1722,7 +1765,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);
 
@@ -1772,6 +1814,7 @@ Perl_padlist_dup(pTHX_ AV *const srcpad, CLONE_PARAMS *const param)
 
        I32 ix = AvFILLp((const AV *)AvARRAY(srcpad)[1]);
        AV *pad1;
+       const I32 names_fill = AvFILLp((const AV *)(AvARRAY(srcpad)[0]));
        const AV *const srcpad1 = (const AV *) AvARRAY(srcpad)[1];
        SV **oldpad = AvARRAY(srcpad1);
        SV **names;
@@ -1803,7 +1846,53 @@ Perl_padlist_dup(pTHX_ AV *const srcpad, CLONE_PARAMS *const param)
            AvFILLp(pad1) = ix;
 
            for ( ;ix > 0; ix--) {
-               pad1a[ix] = sv_dup_inc(oldpad[ix], param);
+               if (!oldpad[ix]) {
+                   pad1a[ix] = NULL;
+               } else if (names_fill >= ix && names[ix] != &PL_sv_undef) {
+                   const char sigil = SvPVX_const(names[ix])[0];
+                   if ((SvFLAGS(names[ix]) & SVf_FAKE)
+                       || (SvFLAGS(names[ix]) & SVpad_STATE)
+                       || sigil == '&')
+                       {
+                           /* outer lexical or anon code */
+                           pad1a[ix] = sv_dup_inc(oldpad[ix], param);
+                       }
+                   else {              /* our own lexical */
+                       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; 
+                           
+                           if (sigil == '@')
+                               sv = MUTABLE_SV(newAV());
+                           else if (sigil == '%')
+                               sv = MUTABLE_SV(newHV());
+                           else
+                               sv = newSV(0);
+                           pad1a[ix] = sv;
+                           SvPADMY_on(sv);
+                       }
+                   }
+               }
+               else if (IS_PADGV(oldpad[ix]) || IS_PADCONST(oldpad[ix])) {
+                   pad1a[ix] = sv_dup_inc(oldpad[ix], param);
+               }
+               else {
+                   /* save temporaries on recursion? */
+                   SV * const sv = newSV(0);
+                   pad1a[ix] = sv;
+
+                   /* SvREFCNT(oldpad[ix]) != 1 for some code in threads.xs
+                      FIXTHAT before merging this branch.
+                      (And I know how to) */
+                   if (SvPADMY(oldpad[ix]))
+                       SvPADMY_on(sv);
+                   else
+                       SvPADTMP_on(sv);
+               }
            }
 
            if (oldpad[0]) {