X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=op.c;h=62309a1f1b34525b508335cb77f43745b07c281e;hb=187122cbaf4bb21705259325ef8e0e420b0241df;hp=b15f9bc8dd581cf5c27d9b3937732269182bbc6a;hpb=25716404fbbde2ca91832aab8c9157aafcdcc7e8;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/op.c b/op.c
index b15f9bc..62309a1 100644
--- a/op.c
+++ b/op.c
@@ -842,12 +842,12 @@ clear_pmop:
 		    lastpmop = pmop;
 		    pmop = pmop->op_pmnext;
 		}
+	    }
 #ifdef USE_ITHREADS
-		Safefree(PmopSTASHPV(cPMOPo));
+	    Safefree(PmopSTASHPV(cPMOPo));
 #else
-		/* NOTE: PMOP.op_pmstash is not refcounted */
+	    /* NOTE: PMOP.op_pmstash is not refcounted */
 #endif
-	    }
 	}
 	cPMOPo->op_pmreplroot = Nullop;
 	ReREFCNT_dec(PM_GETRE(cPMOPo));
@@ -2035,9 +2035,15 @@ Perl_bind_match(pTHX_ I32 type, OP *left, OP *right)
 	right->op_type == OP_SUBST ||
 	right->op_type == OP_TRANS)) {
 	right->op_flags |= OPf_STACKED;
-	if (right->op_type != OP_MATCH &&
-            ! (right->op_type == OP_TRANS &&
-               right->op_private & OPpTRANS_IDENTICAL))
+	if ((right->op_type != OP_MATCH &&
+	     ! (right->op_type == OP_TRANS &&
+		right->op_private & OPpTRANS_IDENTICAL)) ||
+	    /* if SV has magic, then match on original SV, not on its copy.
+	       see note in pp_helem() */
+	    (right->op_type == OP_MATCH &&	
+	     (left->op_type == OP_AELEM ||
+	      left->op_type == OP_HELEM ||
+	      left->op_type == OP_AELEMFAST)))
 	    left = mod(left, right->op_type);
 	if (right->op_type == OP_TRANS)
 	    o = newBINOP(OP_NULL, OPf_STACKED, scalar(left), right);
@@ -2942,7 +2948,16 @@ Perl_newPMOP(pTHX_ I32 type, I32 flags)
 	pmop->op_pmpermflags |= PMf_LOCALE;
     pmop->op_pmflags = pmop->op_pmpermflags;
 
-    /* link into pm list */
+ #ifdef USE_ITHREADS
+        {
+                SV* repointer = newSViv(0);
+                av_push(PL_regex_padav,SvREFCNT_inc(repointer));
+                pmop->op_pmoffset = av_len(PL_regex_padav);
+                PL_regex_pad = AvARRAY(PL_regex_padav);
+        }
+ #endif
+        
+        /* link into pm list */
     if (type != OP_TRANS && PL_curstash) {
 	pmop->op_pmnext = HvPMROOT(PL_curstash);
 	HvPMROOT(PL_curstash) = pmop;
@@ -3187,6 +3202,7 @@ Perl_package(pTHX_ OP *o)
 	op_free(o);
     }
     else {
+	deprecate("\"package\" with no arguments");
 	sv_setpv(PL_curstname,"<none>");
 	PL_curstash = Nullhv;
     }
@@ -4154,9 +4170,10 @@ Perl_cv_undef(pTHX_ CV *cv)
 
 #ifdef USE_ITHREADS
     if (CvFILE(cv) && !CvXSUB(cv)) {
+	/* for XSUBs CvFILE point directly to static memory; __FILE__ */
 	Safefree(CvFILE(cv));
-	CvFILE(cv) = 0;
     }
+    CvFILE(cv) = 0;
 #endif
 
     if (!CvXSUB(cv) && CvROOT(cv)) {
@@ -4598,9 +4615,9 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
 
     cv = (!name || GvCVGEN(gv)) ? Nullcv : GvCV(gv);
 
-#ifdef GV_SHARED_CHECK
-    if (cv && GvSHARED(gv) && SvREADONLY(cv)) {
-        Perl_croak(aTHX_ "Can't define subroutine %s (GV is shared)", name);
+#ifdef GV_UNIQUE_CHECK
+    if (cv && GvUNIQUE(gv) && SvREADONLY(cv)) {
+        Perl_croak(aTHX_ "Can't define subroutine %s (GV is unique)", name);
     }
 #endif
 
@@ -4612,9 +4629,9 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
     if (cv) {
         bool exists = CvROOT(cv) || CvXSUB(cv);
 
-#ifdef GV_SHARED_CHECK
-        if (exists && GvSHARED(gv)) {
-            Perl_croak(aTHX_ "Can't redefine shared subroutine %s", name);
+#ifdef GV_UNIQUE_CHECK
+        if (exists && GvUNIQUE(gv)) {
+            Perl_croak(aTHX_ "Can't redefine unique subroutine %s", name);
         }
 #endif
 
@@ -4733,6 +4750,8 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
 	}
 	/* ... before we throw it away */
 	SvREFCNT_dec(PL_compcv);
+	if (PERLDB_INTER)/* Advice debugger on the new sub. */
+	  ++PL_sub_generation;
     }
     else {
 	cv = PL_compcv;
@@ -5102,9 +5121,9 @@ Perl_newFORM(pTHX_ I32 floor, OP *o, OP *block)
     else
 	name = "STDOUT";
     gv = gv_fetchpv(name,TRUE, SVt_PVFM);
-#ifdef GV_SHARED_CHECK
-    if (GvSHARED(gv)) {
-        Perl_croak(aTHX_ "Bad symbol for form (GV is shared)");
+#ifdef GV_UNIQUE_CHECK
+    if (GvUNIQUE(gv)) {
+        Perl_croak(aTHX_ "Bad symbol for form (GV is unique)");
     }
 #endif
     GvMULTI_on(gv);
@@ -6762,7 +6781,15 @@ Perl_peep(pTHX_ register OP *o)
 	    {
 		PL_curcop = ((COP*)o);
 	    }
-	    goto nothin;
+	    /* XXX: We avoid setting op_seq here to prevent later calls
+	       to peep() from mistakenly concluding that optimisation
+	       has already occurred. This doesn't fix the real problem,
+	       though (See 20010220.007). AMS 20010719 */
+	    if (oldop && o->op_next) {
+		oldop->op_next = o->op_next;
+		continue;
+	    }
+	    break;
 	case OP_SCALAR:
 	case OP_LINESEQ:
 	case OP_SCOPE: