X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=op.c;h=913f1967be7485b54e600eef2f6835ef2355ea71;hb=022735b47c849ae03c52981ea170ac0d5308050c;hp=34fb48a82d747fc10226f517c478ccec4d20297e;hpb=524189f16184b7c26cd5c891db0a97b3ccc255cc;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/op.c b/op.c
index 34fb48a..913f196 100644
--- a/op.c
+++ b/op.c
@@ -346,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:
@@ -369,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);
 	}
     }
@@ -841,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;
     }
 
@@ -1861,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;
@@ -1961,8 +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 && (SvFLAGS(*namesvp) & SVpad_TYPED)
-	    && HvNAME(SvSTASH(*namesvp)))
+	if (namesvp && *namesvp && (SvFLAGS(*namesvp) & SVpad_TYPED))
 	    stash = SvSTASH(*namesvp);
 	else
 	    stash = PL_curstash;
@@ -2968,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);
     }
@@ -3065,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;
 	    }
@@ -4145,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))
@@ -4168,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);
@@ -4284,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));
@@ -4654,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;
@@ -4664,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;
@@ -4718,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;
@@ -4809,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;
@@ -4973,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)
@@ -5092,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]))
@@ -6424,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);