This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Move tests under 'threads' module
[perl5.git] / pp_hot.c
index 2f2876b..1535e4c 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -127,15 +127,6 @@ PP(pp_sassign)
        SV * const temp = left;
        left = right; right = temp;
     }
-    else if (PL_op->op_private & OPpASSIGN_STATE) {
-       if (SvPADSTALE(right))
-           SvPADSTALE_off(right);
-       else {
-           (void)POPs;
-           PUSHs(right);
-           RETURN; /* ignore assignment */
-       }
-    }
     if (PL_tainting && PL_tainted && !SvTAINTED(left))
        TAINT_NOT;
     if (PL_op->op_private & OPpASSIGN_CV_TO_GV) {
@@ -189,11 +180,6 @@ PP(pp_sassign)
            SvREFCNT_dec(cv);
            LEAVE;
        }
-
-       if (strEQ(GvNAME(right),"isa")) {
-           GvCVGEN(right) = 0;
-           ++PL_sub_generation;
-       }
     }
     SvSetMagicSV(right, left);
     SETs(right);
@@ -440,12 +426,13 @@ PP(pp_defined)
                --SP;
             RETURNOP(cLOGOP->op_other);
         }
-    } else if (op_type == OP_DEFINED) {
+    }
+    else {
+       /* OP_DEFINED */
         sv = POPs;
         if (!sv || !SvANY(sv))
             RETPUSHNO;
-    } else
-        DIE(aTHX_ "panic:  Invalid op (%s) in pp_defined()", OP_NAME(PL_op));
+    }
 
     defined = FALSE;
     switch (SvTYPE(sv)) {
@@ -972,13 +959,6 @@ PP(pp_aassign)
     int duplicates = 0;
     SV **firsthashrelem = NULL;        /* "= 0" keeps gcc 2.95 quiet  */
 
-    if (PL_op->op_private & OPpASSIGN_STATE) {
-       if (SvPADSTALE(*firstlelem))
-           SvPADSTALE_off(*firstlelem);
-       else
-           RETURN; /* ignore assignment */
-    }
-
     PL_delaymagic = DM_DELAY;          /* catch simultaneous items */
     gimme = GIMME_V;
 
@@ -1171,6 +1151,15 @@ PP(pp_aassign)
        while (relem <= SP)
            *relem++ = (lelem <= lastlelem) ? *lelem++ : &PL_sv_undef;
     }
+
+    /* This is done at the bottom and in this order because
+       mro_isa_changed_in() can throw exceptions */
+    if(PL_delayedisa) {
+        HV* stash = PL_delayedisa;
+        PL_delayedisa = NULL;
+        mro_isa_changed_in(stash);
+    }
+
     RETURN;
 }
 
@@ -1178,11 +1167,13 @@ PP(pp_qr)
 {
     dVAR; dSP;
     register PMOP * const pm = cPMOP;
+    REGEXP * rx = PM_GETRE(pm);
+    SV * const pkg = CALLREG_PACKAGE(rx);
     SV * const rv = sv_newmortal();
-    SV * const sv = newSVrv(rv, "Regexp");
-    if (pm->op_pmdynflags & PMdf_TAINTED)
+    SV * const sv = newSVrv(rv, SvPV_nolen(pkg));
+    if (rx->extflags & RXf_TAINTED)
         SvTAINTED_on(rv);
-    sv_magic(sv,(SV*)ReREFCNT_inc(PM_GETRE(pm)), PERL_MAGIC_qr,0,0);
+    sv_magic(sv,(SV*)ReREFCNT_inc(rx), PERL_MAGIC_qr,0,0);
     XPUSHs(rv);
     RETURN;
 }
@@ -1222,20 +1213,28 @@ PP(pp_match)
     if (!s)
        DIE(aTHX_ "panic: pp_match");
     strend = s + len;
-    rxtainted = ((pm->op_pmdynflags & PMdf_TAINTED) ||
+    rxtainted = ((rx->extflags & RXf_TAINTED) ||
                 (PL_tainted && (pm->op_pmflags & PMf_RETAINT)));
     TAINT_NOT;
 
     RX_MATCH_UTF8_set(rx, DO_UTF8(TARG));
 
     /* PMdf_USED is set after a ?? matches once */
-    if (pm->op_pmdynflags & PMdf_USED) {
+    if (
+#ifdef USE_ITHREADS
+        SvREADONLY(PL_regex_pad[pm->op_pmoffset])
+#else
+        pm->op_pmflags & PMf_USED
+#endif
+    ) {
       failure:
        if (gimme == G_ARRAY)
            RETURN;
        RETPUSHNO;
     }
 
+
+
     /* empty pattern special-cased to use last successful pattern if possible */
     if (!rx->prelen && PL_curpm) {
        pm = PL_curpm;
@@ -1267,11 +1266,14 @@ PP(pp_match)
            }
        }
     }
-    /* remove comment to get faster /g but possibly unsafe $1 vars after a
-       match. Test for the unsafe vars will fail as well*/
-    if (( /* !global &&  */ rx->nparens) 
+    /* XXX: comment out !global get safe $1 vars after a
+       match, BUT be aware that this leads to drammatic slowdowns on
+       /g matches against large strings.  So far a solution to this problem
+       appears to be quite tricky.
+       Test for the unsafe vars are TODO for now. */
+    if ((  !global &&  rx->nparens) 
            || SvTEMP(TARG) || PL_sawampersand ||
-           (pm->op_pmflags & (PMf_EVAL|PMf_KEEPCOPY)))
+           (rx->extflags & (RXf_EVAL_SEEN|RXf_PMf_KEEPCOPY)))
        r_flags |= REXEC_COPY_STR;
     if (SvSCREAM(TARG))
        r_flags |= REXEC_SCREAM;
@@ -1294,7 +1296,7 @@ play_it_again:
            goto nope;
        if ( (rx->extflags & RXf_CHECK_ALL)
             && !PL_sawampersand
-            && !(pm->op_pmflags & PMf_KEEPCOPY)
+            && !(rx->extflags & RXf_PMf_KEEPCOPY)
             && ((rx->extflags & RXf_NOSCAN)
                 || !((rx->extflags & RXf_INTUIT_TAIL)
                      && (r_flags & REXEC_SCREAM)))
@@ -1304,8 +1306,13 @@ play_it_again:
     if (CALLREGEXEC(rx, (char*)s, (char *)strend, (char*)truebase, minmatch, TARG, INT2PTR(void*, gpos), r_flags))
     {
        PL_curpm = pm;
-       if (dynpm->op_pmflags & PMf_ONCE)
-           dynpm->op_pmdynflags |= PMdf_USED;
+       if (dynpm->op_pmflags & PMf_ONCE) {
+#ifdef USE_ITHREADS
+            SvREADONLY_on(PL_regex_pad[dynpm->op_pmoffset]);
+#else
+           dynpm->op_pmflags |= PMf_USED;
+#endif
+        }
        goto gotcha;
     }
     else
@@ -1401,8 +1408,13 @@ yup:                                     /* Confirmed by INTUIT */
        RX_MATCH_TAINTED_on(rx);
     TAINT_IF(RX_MATCH_TAINTED(rx));
     PL_curpm = pm;
-    if (dynpm->op_pmflags & PMf_ONCE)
-       dynpm->op_pmdynflags |= PMdf_USED;
+    if (dynpm->op_pmflags & PMf_ONCE) {
+#ifdef USE_ITHREADS
+        SvREADONLY_on(PL_regex_pad[dynpm->op_pmoffset]);
+#else
+        dynpm->op_pmflags |= PMf_USED;
+#endif
+    }
     if (RX_MATCH_COPIED(rx))
        Safefree(rx->subbeg);
     RX_MATCH_COPIED_off(rx);
@@ -1421,7 +1433,7 @@ yup:                                      /* Confirmed by INTUIT */
        rx->sublen = strend - truebase;
        goto gotcha;
     }
-    if (PL_sawampersand || pm->op_pmflags & PMf_KEEPCOPY) {
+    if (PL_sawampersand || rx->extflags & RXf_PMf_KEEPCOPY) {
        I32 off;
 #ifdef PERL_OLD_COPY_ON_WRITE
        if (SvIsCOW(TARG) || (SvFLAGS(TARG) & CAN_COW_MASK) == CAN_COW_FLAGS) {
@@ -2035,7 +2047,7 @@ PP(pp_subst)
     s = SvPV_mutable(TARG, len);
     if (!SvPOKp(TARG) || SvTYPE(TARG) == SVt_PVGV)
        force_on_match = 1;
-    rxtainted = ((pm->op_pmdynflags & PMdf_TAINTED) ||
+    rxtainted = ((rx->extflags & RXf_TAINTED) ||
                 (PL_tainted && (pm->op_pmflags & PMf_RETAINT)));
     if (PL_tainted)
        rxtainted |= 2;
@@ -2058,7 +2070,7 @@ PP(pp_subst)
        rx = PM_GETRE(pm);
     }
     r_flags = (rx->nparens || SvTEMP(TARG) || PL_sawampersand
-           || (pm->op_pmflags & (PMf_EVAL|PMf_KEEPCOPY)) )
+           || (rx->extflags & (RXf_EVAL_SEEN|RXf_PMf_KEEPCOPY)) )
               ? REXEC_COPY_STR : 0;
     if (SvSCREAM(TARG))
        r_flags |= REXEC_SCREAM;
@@ -2073,7 +2085,7 @@ PP(pp_subst)
        /* How to do it in subst? */
 /*     if ( (rx->extflags & RXf_CHECK_ALL)
             && !PL_sawampersand
-            && !(pm->op_pmflags & PMf_KEEPCOPY)
+            && !(rx->extflags & RXf_KEEPCOPY)
             && ((rx->extflags & RXf_NOSCAN)
                 || !((rx->extflags & RXf_INTUIT_TAIL)
                      && (r_flags & REXEC_SCREAM))))
@@ -2241,7 +2253,7 @@ PP(pp_subst)
            register PERL_CONTEXT *cx;
            SPAGAIN;
            PUSHSUBST(cx);
-           RETURNOP(cPMOP->op_pmreplroot);
+           RETURNOP(cPMOP->op_pmreplrootu.op_pmreplroot);
        }
        r_flags |= REXEC_IGNOREPOS | REXEC_NOT_FIRST;
        do {
@@ -2701,9 +2713,6 @@ try_autoload:
 
     gimme = GIMME_V;
     if ((PL_op->op_private & OPpENTERSUB_DB) && GvCV(PL_DBsub) && !CvNODEBUG(cv)) {
-        if (CvASSERTION(cv) && PL_DBassertion)
-           sv_setiv(PL_DBassertion, 1);
-       
         Perl_get_db_sub(aTHX_ &sv, cv);
         if (CvISXSUB(cv))
             PL_curcopdb = PL_curcop;
@@ -3040,7 +3049,8 @@ S_method_common(pTHX_ SV* meth, U32* hashp)
        if (he) {
            gv = (GV*)HeVAL(he);
            if (isGV(gv) && GvCV(gv) &&
-               (!GvCVGEN(gv) || GvCVGEN(gv) == PL_sub_generation))
+               (!GvCVGEN(gv) || GvCVGEN(gv)
+                  == (PL_sub_generation + HvMROMETA(stash)->cache_gen)))
                return (SV*)GvCV(gv);
        }
     }