Integrate Memoize 0.64. Few tweaks were required in

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

diff --git a/op.c b/op.c
index 49b242a..6e42527 100644 (file)
--- a/op.c
+++ b/op.c
@@ -183,10 +183,9 @@ Perl_pad_allocmy(pTHX_ char *name)
        if (*name != '$')
            yyerror(Perl_form(aTHX_ "Can't declare class for non-scalar %s in \"%s\"",
                         name, PL_in_my == KEY_our ? "our" : "my"));
-       SvOBJECT_on(sv);
+       SvFLAGS(sv) |= SVpad_TYPED;
        (void)SvUPGRADE(sv, SVt_PVMG);
        SvSTASH(sv) = (HV*)SvREFCNT_inc(PL_in_my_stash);
-       PL_sv_objcount++;
     }
     if (PL_in_my == KEY_our) {
        (void)SvUPGRADE(sv, SVt_PVGV);
@@ -223,11 +222,10 @@ S_pad_addlex(pTHX_ SV *proto_namesv)
        (void)SvUPGRADE(namesv, SVt_PVGV);
        GvSTASH(namesv) = (HV*)SvREFCNT_inc((SV*)GvSTASH(proto_namesv));
     }
-    if (SvOBJECT(proto_namesv)) {              /* A typed var */
-       SvOBJECT_on(namesv);
+    if (SvFLAGS(proto_namesv) & SVpad_TYPED) { /* A typed lexical */
+       SvFLAGS(namesv) |= SVpad_TYPED;
        (void)SvUPGRADE(namesv, SVt_PVMG);
        SvSTASH(namesv) = (HV*)SvREFCNT_inc((SV*)SvSTASH(proto_namesv));
-       PL_sv_objcount++;
     }
     return newoff;
 }
@@ -348,15 +346,24 @@ S_pad_findlex(pTHX_ char *name, PADOFFSET newoff, U32 seq, CV* startcv,
        switch (CxTYPE(cx)) {
        default:
            if (i == 0 && saweval) {
-               seq = cxstack[saweval].blk_oldcop->cop_seq;
                return pad_findlex(name, newoff, seq, PL_main_cv, -1, saweval, 0);
            }
            break;
        case CXt_EVAL:
            switch (cx->blk_eval.old_op_type) {
            case OP_ENTEREVAL:
-               if (CxREALEVAL(cx))
+               if (CxREALEVAL(cx)) {
+                   PADOFFSET off;
                    saweval = i;
+                   seq = cxstack[i].blk_oldcop->cop_seq;
+                   startcv = cxstack[i].blk_eval.cv;
+                   if (startcv && CvOUTSIDE(startcv)) {
+                       off = pad_findlex(name, newoff, seq, CvOUTSIDE(startcv),
+                                         i-1, saweval, 0);
+                       if (off)        /* continue looking if not found here */
+                           return off;
+                   }
+               }
                break;
            case OP_DOFILE:
            case OP_REQUIRE:
@@ -373,7 +380,6 @@ S_pad_findlex(pTHX_ char *name, PADOFFSET newoff, U32 seq, CV* startcv,
                saweval = i;    /* so we know where we were called from */
                continue;
            }
-           seq = cxstack[saweval].blk_oldcop->cop_seq;
            return pad_findlex(name, newoff, seq, cv, i-1, saweval,FINDLEX_NOSEARCH);
        }
     }
@@ -1963,7 +1969,8 @@ S_my_kid(pTHX_ OP *o, OP *attrs)
 
        /* check for C<my Dog $spot> when deciding package */
        namesvp = av_fetch(PL_comppad_name, o->op_targ, FALSE);
-       if (namesvp && *namesvp && SvOBJECT(*namesvp) && HvNAME(SvSTASH(*namesvp)))
+       if (namesvp && *namesvp && (SvFLAGS(*namesvp) & SVpad_TYPED)
+           && HvNAME(SvSTASH(*namesvp)))
            stash = SvSTASH(*namesvp);
        else
            stash = PL_curstash;
@@ -4169,9 +4176,15 @@ Perl_cv_undef(pTHX_ CV *cv)
      * CV, they don't hold a refcount on the outside CV.  This avoids
      * the refcount loop between the outer CV (which keeps a refcount to
      * the closure prototype in the pad entry for pp_anoncode()) and the
-     * closure prototype, and the ensuing memory leak.  --GSAR */
-    if (!CvANON(cv) || CvCLONED(cv))
+     * closure prototype, and the ensuing memory leak.  This does not
+     * apply to closures generated within eval"", since eval"" CVs are
+     * ephemeral. --GSAR */
+    if (!CvANON(cv) || CvCLONED(cv)
+       || (CvOUTSIDE(cv) && SvTYPE(CvOUTSIDE(cv)) == SVt_PVCV
+           && CvEVAL(CvOUTSIDE(cv)) && !CvGV(CvOUTSIDE(cv))))
+    {
        SvREFCNT_dec(CvOUTSIDE(cv));
+    }
     CvOUTSIDE(cv) = Nullcv;
     if (CvCONST(cv)) {
        SvREFCNT_dec((SV*)CvXSUBANY(cv).any_ptr);
@@ -4810,12 +4823,17 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
        }
     }
 
-    /* If a potential closure prototype, don't keep a refcount on outer CV.
+    /* If a potential closure prototype, don't keep a refcount on
+     * outer CV, unless the latter happens to be a passing eval"".
      * This is okay as the lifetime of the prototype is tied to the
      * lifetime of the outer CV.  Avoids memory leak due to reference
      * loop. --GSAR */
-    if (!name)
+    if (!name && CvOUTSIDE(cv)
+       && !(SvTYPE(CvOUTSIDE(cv)) == SVt_PVCV
+            && CvEVAL(CvOUTSIDE(cv)) && !CvGV(CvOUTSIDE(cv))))
+    {
        SvREFCNT_dec(CvOUTSIDE(cv));
+    }
 
     if (name || aname) {
        char *s;
@@ -6887,7 +6905,7 @@ Perl_peep(pTHX_ register OP *o)
            if (rop->op_type != OP_RV2HV || rop->op_first->op_type != OP_PADSV)
                break;
            lexname = *av_fetch(PL_comppad_name, rop->op_first->op_targ, TRUE);
-           if (!SvOBJECT(lexname))
+           if (!(SvFLAGS(lexname) & SVpad_TYPED))
                break;
            fields = (GV**)hv_fetch(SvSTASH(lexname), "FIELDS", 6, FALSE);
            if (!fields || !GvHV(*fields))
@@ -6937,7 +6955,7 @@ Perl_peep(pTHX_ register OP *o)
            if (rop->op_type != OP_RV2HV || rop->op_first->op_type != OP_PADSV)
                break;
            lexname = *av_fetch(PL_comppad_name, rop->op_first->op_targ, TRUE);
-           if (!SvOBJECT(lexname))
+           if (!(SvFLAGS(lexname) & SVpad_TYPED))
                break;
            fields = (GV**)hv_fetch(SvSTASH(lexname), "FIELDS", 6, FALSE);
            if (!fields || !GvHV(*fields))