Fixes compile errors in four files
[p5sagit/p5-mst-13.2.git] / op.c
diff --git a/op.c b/op.c
index 9e1d078..913f196 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:
@@ -371,9 +378,9 @@ S_pad_findlex(pTHX_ char *name, PADOFFSET newoff, U32 seq, CV* startcv,
            cv = cx->blk_sub.cv;
            if (PL_debstash && CvSTASH(cv) == PL_debstash) {    /* ignore DB'* scope */
                saweval = i;    /* so we know where we were called from */
+               seq = cxstack[i].blk_oldcop->cop_seq;
                continue;
            }
-           seq = cxstack[saweval].blk_oldcop->cop_seq;
            return pad_findlex(name, newoff, seq, cv, i-1, saweval,FINDLEX_NOSEARCH);
        }
     }
@@ -843,8 +850,8 @@ clear_pmop:
            }
        }
        cPMOPo->op_pmreplroot = Nullop;
-       ReREFCNT_dec(cPMOPo->op_pmregexp);
-       cPMOPo->op_pmregexp = (REGEXP*)NULL;
+       ReREFCNT_dec(PM_GETRE(cPMOPo));
+       PM_SETRE(cPMOPo, (REGEXP*)NULL);
        break;
     }
 
@@ -1863,7 +1870,7 @@ S_apply_attrs(pTHX_ HV *stash, SV *target, OP *attrs)
     /* fake up C<use attributes $pkg,$rv,@attrs> */
     ENTER;             /* need to protect against side-effects of 'use' */
     SAVEINT(PL_expect);
-    if (stash && HvNAME(stash))
+    if (stash)
        stashsv = newSVpv(HvNAME(stash), 0);
     else
        stashsv = &PL_sv_no;
@@ -1963,7 +1970,7 @@ 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))
            stash = SvSTASH(*namesvp);
        else
            stash = PL_curstash;
@@ -2268,8 +2275,8 @@ Perl_fold_constants(pTHX_ register OP *o)
     case OP_SLE:
     case OP_SGE:
     case OP_SCMP:
-
-       if (o->op_private & OPpLOCALE)
+       /* XXX what about the numeric ops? */
+       if (PL_hints & HINT_LOCALE)
            goto nope;
     }
 
@@ -2969,8 +2976,8 @@ Perl_pmruntime(pTHX_ OP *o, OP *expr, OP *repl)
        }
        if ((PL_hints & HINT_UTF8) || DO_UTF8(pat))
            pm->op_pmdynflags |= PMdf_UTF8;
-       pm->op_pmregexp = CALLREGCOMP(aTHX_ p, p + plen, pm);
-       if (strEQ("\\s+", pm->op_pmregexp->precomp))
+       PM_SETRE(pm, CALLREGCOMP(aTHX_ p, p + plen, pm));
+       if (strEQ("\\s+", PM_GETRE(pm)->precomp))
            pm->op_pmflags |= PMf_WHITE;
        op_free(expr);
     }
@@ -3066,14 +3073,14 @@ Perl_pmruntime(pTHX_ OP *o, OP *expr, OP *repl)
        }
        if (curop == repl
            && !(repl_has_vars
-                && (!pm->op_pmregexp
-                    || pm->op_pmregexp->reganch & ROPT_EVAL_SEEN))) {
+                && (!PM_GETRE(pm)
+                    || PM_GETRE(pm)->reganch & ROPT_EVAL_SEEN))) {
            pm->op_pmflags |= PMf_CONST;        /* const for long enough */
            pm->op_pmpermflags |= PMf_CONST;    /* const for long enough */
            prepend_elem(o->op_type, scalar(repl), o);
        }
        else {
-           if (curop == repl && !pm->op_pmregexp) { /* Has variables. */
+           if (curop == repl && !PM_GETRE(pm)) { /* Has variables. */
                pm->op_pmflags |= PMf_MAYBE_CONST;
                pm->op_pmpermflags |= PMf_MAYBE_CONST;
            }
@@ -4146,6 +4153,13 @@ Perl_cv_undef(pTHX_ CV *cv)
     }
 #endif /* USE_THREADS */
 
+#ifdef USE_ITHREADS
+    if (CvFILE(cv) && !CvXSUB(cv)) {
+       Safefree(CvFILE(cv));
+       CvFILE(cv) = 0;
+    }
+#endif
+
     if (!CvXSUB(cv) && CvROOT(cv)) {
 #ifdef USE_THREADS
        if (CvDEPTH(cv) || (CvOWNER(cv) && CvOWNER(cv) != thr))
@@ -4169,9 +4183,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);
@@ -4285,7 +4305,12 @@ S_cv_clone2(pTHX_ CV *proto, CV *outside)
     MUTEX_INIT(CvMUTEXP(cv));
     CvOWNER(cv)                = 0;
 #endif /* USE_THREADS */
+#ifdef USE_ITHREADS
+    CvFILE(cv)         = CvXSUB(proto) ? CvFILE(proto)
+                                       : savepv(CvFILE(proto));
+#else
     CvFILE(cv)         = CvFILE(proto);
+#endif
     CvGV(cv)           = CvGV(proto);
     CvSTASH(cv)                = CvSTASH(proto);
     CvROOT(cv)         = OpREFCNT_inc(CvROOT(proto));
@@ -4655,9 +4680,9 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
         */
        if (cv && !block) {
            rcv = (SV*)cv;
-           if (CvGV(cv) && GvSTASH(CvGV(cv)) && HvNAME(GvSTASH(CvGV(cv))))
+           if (CvGV(cv) && GvSTASH(CvGV(cv)))
                stash = GvSTASH(CvGV(cv));
-           else if (CvSTASH(cv) && HvNAME(CvSTASH(cv)))
+           else if (CvSTASH(cv))
                stash = CvSTASH(cv);
            else
                stash = PL_curstash;
@@ -4665,7 +4690,7 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
        else {
            /* possibly about to re-define existing subr -- ignore old cv */
            rcv = (SV*)PL_compcv;
-           if (name && GvSTASH(gv) && HvNAME(GvSTASH(gv)))
+           if (name && GvSTASH(gv))
                stash = GvSTASH(gv);
            else
                stash = PL_curstash;
@@ -4719,7 +4744,7 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
        }
     }
     CvGV(cv) = gv;
-    CvFILE(cv) = CopFILE(PL_curcop);
+    CvFILE_set_from_cop(cv, PL_curcop);
     CvSTASH(cv) = PL_curstash;
 #ifdef USE_THREADS
     CvOWNER(cv) = 0;
@@ -4810,12 +4835,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;
@@ -4974,7 +5004,6 @@ Perl_newXS(pTHX_ char *name, XSUBADDR_t subaddr, char *filename)
        else if (CvROOT(cv) || CvXSUB(cv) || GvASSUMECV(gv)) {
            /* already defined (or promised) */
            if (ckWARN(WARN_REDEFINE) && !(CvGV(cv) && GvSTASH(CvGV(cv))
-                           && HvNAME(GvSTASH(CvGV(cv)))
                            && strEQ(HvNAME(GvSTASH(CvGV(cv))), "autouse"))) {
                line_t oldline = CopLINE(PL_curcop);
                if (PL_copline != NOLINE)
@@ -5093,7 +5122,7 @@ Perl_newFORM(pTHX_ I32 floor, OP *o, OP *block)
     cv = PL_compcv;
     GvFORM(gv) = cv;
     CvGV(cv) = gv;
-    CvFILE(cv) = CopFILE(PL_curcop);
+    CvFILE_set_from_cop(cv, PL_curcop);
 
     for (ix = AvFILLp(PL_comppad); ix > 0; ix--) {
        if (!SvPADMY(PL_curpad[ix]) && !SvIMMORTAL(PL_curpad[ix]))
@@ -5605,13 +5634,6 @@ Perl_ck_ftst(pTHX_ OP *o)
        else
            o = newUNOP(type, 0, newDEFSVOP());
     }
-#ifdef USE_LOCALE
-    if (type == OP_FTTEXT || type == OP_FTBINARY) {
-       o->op_private = 0;
-       if (PL_hints & HINT_LOCALE)
-           o->op_private |= OPpLOCALE;
-    }
-#endif
     return o;
 }
 
@@ -6021,29 +6043,7 @@ Perl_ck_listiob(pTHX_ OP *o)
     if (!kid)
        append_elem(o->op_type, o, newDEFSVOP());
 
-    o = listkids(o);
-
-    o->op_private = 0;
-#ifdef USE_LOCALE
-    if (PL_hints & HINT_LOCALE)
-       o->op_private |= OPpLOCALE;
-#endif
-
-    return o;
-}
-
-OP *
-Perl_ck_fun_locale(pTHX_ OP *o)
-{
-    o = ck_fun(o);
-
-    o->op_private = 0;
-#ifdef USE_LOCALE
-    if (PL_hints & HINT_LOCALE)
-       o->op_private |= OPpLOCALE;
-#endif
-
-    return o;
+    return listkids(o);
 }
 
 OP *
@@ -6077,18 +6077,6 @@ Perl_ck_sassign(pTHX_ OP *o)
 }
 
 OP *
-Perl_ck_scmp(pTHX_ OP *o)
-{
-    o->op_private = 0;
-#ifdef USE_LOCALE
-    if (PL_hints & HINT_LOCALE)
-       o->op_private |= OPpLOCALE;
-#endif
-
-    return o;
-}
-
-OP *
 Perl_ck_match(pTHX_ OP *o)
 {
     o->op_private |= OPpRUNTIME;
@@ -6285,11 +6273,6 @@ OP *
 Perl_ck_sort(pTHX_ OP *o)
 {
     OP *firstkid;
-    o->op_private = 0;
-#ifdef USE_LOCALE
-    if (PL_hints & HINT_LOCALE)
-       o->op_private |= OPpLOCALE;
-#endif
 
     if (o->op_type == OP_SORT && o->op_flags & OPf_STACKED)
        simplify_sort(o);
@@ -6471,8 +6454,8 @@ Perl_ck_join(pTHX_ OP *o)
        OP *kid = cLISTOPo->op_first->op_sibling;
        if (kid && kid->op_type == OP_MATCH) {
            char *pmstr = "STRING";
-           if (kPMOP->op_pmregexp)
-               pmstr = kPMOP->op_pmregexp->precomp;
+           if (PM_GETRE(kPMOP))
+               pmstr = PM_GETRE(kPMOP)->precomp;
            Perl_warner(aTHX_ WARN_SYNTAX,
                        "/%s/ should probably be written as \"%s\"",
                        pmstr, pmstr);
@@ -6933,7 +6916,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))
@@ -6983,7 +6966,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))