This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
https://perl5.git.perl.org / perl5.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
[perl5db] Convert tabs to spaces.
[perl5.git] / pad.c
diff --git a/pad.c b/pad.c
index f6c47f5..2292aaf 100644 (file)
--- a/pad.c
+++ b/pad.c
@@ -280,7 +280,6 @@ Perl_pad_new(pTHX_ int flags)
        padname = (PAD *)SvREFCNT_inc_simple_NN(PL_comppad_name);
     }
     else {
-       padlist->xpadl_id = PL_padlist_generation++;
        av_store(pad, 0, NULL);
        padname = newAV();
     }
@@ -1116,6 +1115,17 @@ the parent pad.
 /* the CV does late binding of its lexicals */
 #define CvLATE(cv) (CvANON(cv) || CvCLONE(cv) || SvTYPE(cv) == SVt_PVFM)
 
+static void
+S_unavailable(pTHX_ SV *namesv)
+{
+    /* diag_listed_as: Variable "%s" is not available */
+    Perl_ck_warner(aTHX_ packWARN(WARN_CLOSURE),
+                       "%se \"%"SVf"\" is not available",
+                        *SvPVX_const(namesv) == '&'
+                                        ? "Subroutin"
+                                        : "Variabl",
+                        namesv);
+}
 
 STATIC PADOFFSET
 S_pad_findlex(pTHX_ const char *namepv, STRLEN namelen, U32 flags, const CV* cv, U32 seq,
@@ -1238,8 +1248,7 @@ S_pad_findlex(pTHX_ const char *namepv, STRLEN namelen, U32 flags, const CV* cv,
                        : *out_flags & PAD_FAKELEX_ANON)
                {
                    if (warn)
-                       Perl_ck_warner(aTHX_ packWARN(WARN_CLOSURE),
-                                      "Variable \"%"SVf"\" is not available",
+                       S_unavailable(aTHX_
                                        newSVpvn_flags(namepv, namelen,
                                            SVs_TEMP |
                                            (flags & padadd_UTF8_NAME ? SVf_UTF8 : 0)));
@@ -1287,8 +1296,7 @@ S_pad_findlex(pTHX_ const char *namepv, STRLEN namelen, U32 flags, const CV* cv,
                        && (!CvDEPTH(cv) || !staleok)
                        && !SvPAD_STATE(name_svp[offset]))
                    {
-                       Perl_ck_warner(aTHX_ packWARN(WARN_CLOSURE),
-                                      "Variable \"%"SVf"\" is not available",
+                       S_unavailable(aTHX_
                                        newSVpvn_flags(namepv, namelen,
                                            SVs_TEMP |
                                            (flags & padadd_UTF8_NAME ? SVf_UTF8 : 0)));
@@ -1374,6 +1382,8 @@ S_pad_findlex(pTHX_ const char *namepv, STRLEN namelen, U32 flags, const CV* cv,
        else {
            /* immediate creation - capture outer value right now */
            av_store(PL_comppad, new_offset, SvREFCNT_inc(*new_capturep));
+           /* But also note the offset, as newMYSUB needs it */
+           PARENT_PAD_INDEX_set(new_namesv, offset);
            DEBUG_Xv(PerlIO_printf(Perl_debug_log,
                "Pad findlex cv=0x%"UVxf" saved captured sv 0x%"UVxf" at offset %ld\n",
                PTR2UV(cv), PTR2UV(*new_capturep), (long)new_offset));
@@ -1659,7 +1669,7 @@ S_pad_reset(pTHX)
            )
     );
 
-    if (!PL_tainting) {        /* Can't mix tainted and non-tainted temporaries. */
+    if (!TAINTING_get) {       /* Can't mix tainted and non-tainted temporaries. */
         I32 po;
        for (po = AvMAX(PL_comppad); po > PL_padix_floor; po--) {
            if (PL_curpad[po] && !SvIMMORTAL(PL_curpad[po]))
@@ -1800,6 +1810,7 @@ void
 Perl_pad_free(pTHX_ PADOFFSET po)
 {
     dVAR;
+    SV *sv;
     ASSERT_CURPAD_LEGAL("pad_free");
     if (!PL_curpad)
        return;
@@ -1814,9 +1825,11 @@ Perl_pad_free(pTHX_ PADOFFSET po)
            PTR2UV(PL_comppad), PTR2UV(PL_curpad), (long)po)
     );
 
-    if (PL_curpad[po] && PL_curpad[po] != &PL_sv_undef) {
-       SvFLAGS(PL_curpad[po]) &= ~SVs_PADTMP; /* also clears SVs_PADSTALE */
-    }
+
+    sv = PL_curpad[po];
+    if (sv && sv != &PL_sv_undef && !SvPADMY(sv))
+       SvFLAGS(sv) &= ~SVs_PADTMP;
+
     if ((I32)po < PL_padix)
        PL_padix = po - 1;
 }
@@ -1977,17 +1990,14 @@ S_cv_clone_pad(pTHX_ CV *proto, CV *cv, CV *outside)
      */
 
     if (!outside) {
-      if (SvTYPE(proto) == SVt_PVCV)
-      {
+      if (CvWEAKOUTSIDE(proto))
        outside = find_runcv(NULL);
-       if (!CvANON(proto) && CvROOT(outside) != CvROOT(CvOUTSIDE(proto)))
-           outside = CvOUTSIDE(proto);
-      }
       else {
        outside = CvOUTSIDE(proto);
        if ((CvCLONE(outside) && ! CvCLONED(outside))
            || !CvPADLIST(outside)
-           || CvPADLIST(outside)->xpadl_id != protopadlist->xpadl_outid) {
+           || PadlistNAMES(CvPADLIST(outside))
+                != protopadlist->xpadl_outid) {
            outside = find_runcv_where(
                FIND_RUNCV_padid_eq, (IV)protopadlist->xpadl_outid, NULL
            );
@@ -1998,7 +2008,6 @@ S_cv_clone_pad(pTHX_ CV *proto, CV *cv, CV *outside)
     depth = outside ? CvDEPTH(outside) : 0;
     if (!depth)
        depth = 1;
-    assert(SvTYPE(proto) == SVt_PVFM || CvPADLIST(outside));
 
     ENTER;
     SAVESPTR(PL_compcv);
@@ -2010,7 +2019,6 @@ S_cv_clone_pad(pTHX_ CV *proto, CV *cv, CV *outside)
     SAVESPTR(PL_comppad_name);
     PL_comppad_name = protopad_name;
     CvPADLIST(cv) = pad_new(padnew_CLONE|padnew_SAVE);
-    CvPADLIST(cv)->xpadl_id = protopadlist->xpadl_id;
 
     av_fill(PL_comppad, fpad);
 
@@ -2019,8 +2027,8 @@ S_cv_clone_pad(pTHX_ CV *proto, CV *cv, CV *outside)
     outpad = outside && CvPADLIST(outside)
        ? AvARRAY(PadlistARRAY(CvPADLIST(outside))[depth])
        : NULL;
-    assert(outpad || SvTYPE(cv) == SVt_PVFM);
-    if (outpad) CvPADLIST(cv)->xpadl_outid = CvPADLIST(outside)->xpadl_id;
+    if (outpad)
+       CvPADLIST(cv)->xpadl_outid = PadlistNAMES(CvPADLIST(outside));
 
     for (ix = fpad; ix > 0; ix--) {
        SV* const namesv = (ix <= fname) ? pname[ix] : NULL;
@@ -2032,8 +2040,7 @@ S_cv_clone_pad(pTHX_ CV *proto, CV *cv, CV *outside)
                if (!outpad || !(sv = outpad[PARENT_PAD_INDEX(namesv)])
                 || (  SvPADSTALE(sv) && !SvPAD_STATE(namesv)
                    && (!outside || !CvDEPTH(outside)))  ) {
-                   Perl_ck_warner(aTHX_ packWARN(WARN_CLOSURE),
-                                  "Variable \"%"SVf"\" is not available", namesv);
+                   S_unavailable(aTHX_ namesv);
                    sv = NULL;
                }
                else 
@@ -2057,21 +2064,16 @@ S_cv_clone_pad(pTHX_ CV *proto, CV *cv, CV *outside)
                    else if (PadnameLEN(namesv)>1 && !PadnameIsOUR(namesv))
                    {
                        /* my sub */
-                       /* This is actually a stub with a proto CV attached
-                          to it by magic.  Since the stub itself is used
-                          when the proto is cloned, we need a new stub
-                          that nonetheless shares the same proto.
-                        */
-                       MAGIC * const mg =
-                           mg_find(ppad[ix], PERL_MAGIC_proto);
-                       assert(mg);
-                       assert(mg->mg_obj);
-                       assert(SvTYPE(ppad[ix]) == SVt_PVCV);
-                       assert(CvNAME_HEK((CV *)ppad[ix]));
+                       /* Just provide a stub, but name it.  It will be
+                          upgrade to the real thing on scope entry. */
                        sv = newSV_type(SVt_PVCV);
-                       CvNAME_HEK_set(sv,
-                           share_hek_hek(CvNAME_HEK((CV *)ppad[ix])));
-                       sv_magic(sv,mg->mg_obj,PERL_MAGIC_proto,NULL,0);
+                       CvNAME_HEK_set(
+                           sv,
+                           share_hek(SvPVX_const(namesv)+1,
+                                     SvCUR(namesv) - 1
+                                        * (SvUTF8(namesv) ? -1 : 1),
+                                     0)
+                       );
                    }
                    else sv = SvREFCNT_inc(ppad[ix]);
                 else if (sigil == '@')
@@ -2110,6 +2112,8 @@ S_cv_clone_pad(pTHX_ CV *proto, CV *cv, CV *outside)
 static CV *
 S_cv_clone(pTHX_ CV *proto, CV *cv, CV *outside)
 {
+    dVAR;
+
     assert(!CvUNIQUE(proto));
 
     if (!cv) cv = MUTABLE_CV(newSV_type(SvTYPE(proto)));
Unnamed repository; edit this file 'description' to name the repository.