X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=pp_hot.c;h=0851ab8d1e4c69366803eea240aa58686dc2dbad;hb=d84c672d23e941bae9d05e88fa42ae466c892856;hp=3bc448d52a6cd7115a801a82d11186bbc0609390;hpb=081fc587427bbceff63d5141014aee022b3f9dd6;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/pp_hot.c b/pp_hot.c
index 3bc448d..0851ab8 100644
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -1,6 +1,7 @@
 /*    pp_hot.c
  *
- *    Copyright (c) 1991-2003, Larry Wall
+ *    Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
+ *    2000, 2001, 2002, 2003, by Larry Wall and others
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
@@ -807,7 +808,7 @@ PP(pp_rv2hv)
 	    RETURN;
 	}
 	else if (LVRET) {
-	    if (GIMME == G_SCALAR)
+	    if (GIMME != G_SCALAR)
 		Perl_croak(aTHX_ "Can't return hash to lvalue scalar context");
 	    SETs((SV*)hv);
 	    RETURN;
@@ -1233,7 +1234,7 @@ PP(pp_match)
     if (SvSCREAM(TARG))
 	r_flags |= REXEC_SCREAM;
 
-    if (pm->op_pmflags & (PMf_MULTILINE|PMf_SINGLELINE)) {
+    if ((int)(pm->op_pmflags & PMf_MULTILINE) != PL_multiline) {
 	SAVEINT(PL_multiline);
 	PL_multiline = pm->op_pmflags & PMf_MULTILINE;
     }
@@ -1405,7 +1406,7 @@ yup:					/* Confirmed by INTUIT */
 	rx->startp[0] = s - truebase;
 	rx->endp[0] = s - truebase + rx->minlen;
     }
-    rx->nparens = rx->lastparen = 0;	/* used by @- and @+ */
+    rx->nparens = rx->lastparen = rx->lastcloseparen = 0;	/* used by @-, @+, and $^N */
     LEAVE_SCOPE(oldsave);
     RETPUSHYES;
 
@@ -1496,7 +1497,7 @@ Perl_do_readline(pTHX)
 	    /* undef TARG, and push that undefined value */
 	    if (type != OP_RCATLINE) {
 		SV_CHECK_THINKFIRST_COW_DROP(TARG);
-		SvOK_off(TARG);
+		(void)SvOK_off(TARG);
 	    }
 	    PUSHTARG;
 	}
@@ -1560,7 +1561,7 @@ Perl_do_readline(pTHX)
 	    if (gimme == G_SCALAR) {
 		if (type != OP_RCATLINE) {
 		    SV_CHECK_THINKFIRST_COW_DROP(TARG);
-		    SvOK_off(TARG);
+		    (void)SvOK_off(TARG);
 		}
 		SPAGAIN;
 		PUSHTARG;
@@ -1858,6 +1859,12 @@ PP(pp_iter)
     else {
 	sv = AvARRAY(av)[++cx->blk_loop.iterix];
     }
+    if (sv && SvREFCNT(sv) == 0) {
+	*itersvp = Nullsv;
+	Perl_croak(aTHX_
+	    "Use of freed value in iteration (perhaps you modified the iterated array within the loop?)");
+    }
+
     if (sv)
 	SvTEMP_off(sv);
     else
@@ -1972,7 +1979,7 @@ PP(pp_subst)
 	       ? REXEC_COPY_STR : 0;
     if (SvSCREAM(TARG))
 	r_flags |= REXEC_SCREAM;
-    if (pm->op_pmflags & (PMf_MULTILINE|PMf_SINGLELINE)) {
+    if ((int)(pm->op_pmflags & PMf_MULTILINE) != PL_multiline) {
 	SAVEINT(PL_multiline);
 	PL_multiline = pm->op_pmflags & PMf_MULTILINE;
     }
@@ -2154,6 +2161,7 @@ PP(pp_subst)
 	if (!c) {
 	    register PERL_CONTEXT *cx;
 	    SPAGAIN;
+	    ReREFCNT_inc(rx);
 	    PUSHSUBST(cx);
 	    RETURNOP(cPMOP->op_pmreplroot);
 	}
@@ -2283,6 +2291,7 @@ PP(pp_leavesub)
     SV *sv;
 
     POPBLOCK(cx,newpm);
+    cxstack_ix++; /* temporarily protect top context */
 
     TAINT_NOT;
     if (gimme == G_SCALAR) {
@@ -2321,6 +2330,7 @@ PP(pp_leavesub)
     PUTBACK;
 
     LEAVE;
+    cxstack_ix--;
     POPSUB(cx,sv);	/* Stack values are safe: release CV and @_ ... */
     PL_curpm = newpm;	/* ... and pop $1 et al */
 
@@ -2341,6 +2351,7 @@ PP(pp_leavesublv)
     SV *sv;
 
     POPBLOCK(cx,newpm);
+    cxstack_ix++; /* temporarily protect top context */
 
     TAINT_NOT;
 
@@ -2377,6 +2388,7 @@ PP(pp_leavesublv)
 	 * TEMP, so sv_2mortal is out of question. */
 	if (!CvLVALUE(cx->blk_sub.cv)) {
 	    LEAVE;
+	    cxstack_ix--;
 	    POPSUB(cx,sv);
 	    PL_curpm = newpm;
 	    LEAVESUB(sv);
@@ -2388,6 +2400,7 @@ PP(pp_leavesublv)
 	    if (MARK == SP) {
 		if (SvFLAGS(TOPs) & (SVs_TEMP | SVs_PADTMP | SVf_READONLY)) {
 		    LEAVE;
+		    cxstack_ix--;
 		    POPSUB(cx,sv);
 		    PL_curpm = newpm;
 		    LEAVESUB(sv);
@@ -2403,6 +2416,7 @@ PP(pp_leavesublv)
 	    }
 	    else {			/* Should not happen? */
 		LEAVE;
+		cxstack_ix--;
 		POPSUB(cx,sv);
 		PL_curpm = newpm;
 		LEAVESUB(sv);
@@ -2419,6 +2433,7 @@ PP(pp_leavesublv)
 		    /* Might be flattened array after $#array =  */
 		    PUTBACK;
 		    LEAVE;
+		    cxstack_ix--;
 		    POPSUB(cx,sv);
 		    PL_curpm = newpm;
 		    LEAVESUB(sv);
@@ -2473,6 +2488,7 @@ PP(pp_leavesublv)
     PUTBACK;
 
     LEAVE;
+    cxstack_ix--;
     POPSUB(cx,sv);	/* Stack values are safe: release CV and @_ ... */
     PL_curpm = newpm;	/* ... and pop $1 et al */
 
@@ -2928,15 +2944,16 @@ S_method_common(pTHX_ SV* meth, U32* hashp)
 	packname = Nullch;
 
         if(SvOK(sv) && (packname = SvPV(sv, packlen))) {
-          HE* he = hv_fetch_ent(PL_stashcache, sv, 0, 0);
+          HE* he;
+	  he = hv_fetch_ent(PL_stashcache, sv, 0, 0);
           if (he) { 
-            stash = HeVAL(he);
+            stash = INT2PTR(HV*,SvIV(HeVAL(he)));
             goto fetch;
           }
         }
 
 	if (!SvOK(sv) ||
-	    !(packname = SvPV(sv, packlen)) ||
+	    !(packname) ||
 	    !(iogv = gv_fetchpv(packname, FALSE, SVt_PVIO)) ||
 	    !(ob=(SV*)GvIO(iogv)))
 	{
@@ -2956,10 +2973,9 @@ S_method_common(pTHX_ SV* meth, U32* hashp)
 	    if (!stash)
 		packsv = sv;
             else {
-              SvREFCNT_inc((SV*)stash);
-              if(!hv_store(PL_stashcache, packname, packlen, stash, 0))
-                SvREFCNT_dec((SV*)stash);
-            }
+	        SV* ref = newSViv(PTR2IV(stash));
+	        hv_store(PL_stashcache, packname, packlen, ref, 0);
+	    }
 	    goto fetch;
 	}
 	/* it _is_ a filehandle name -- replace with a reference */
@@ -3016,7 +3032,11 @@ S_method_common(pTHX_ SV* meth, U32* hashp)
 	    /* the method name is unqualified or starts with SUPER:: */ 
 	    packname = sep ? CopSTASHPV(PL_curcop) :
 		stash ? HvNAME(stash) : packname;
-	    packlen = strlen(packname);
+	    if (!packname)
+		Perl_croak(aTHX_
+			   "Can't use anonymous symbol table for method lookup");
+	    else
+		packlen = strlen(packname);
 	}
 	else {
 	    /* the method name is qualified */