Revert 4 regex commits to ease rebasing

[perl5.git] / pp_ctl.c

diff --git a/pp_ctl.c b/pp_ctl.c
index 271dfb2..2cde665 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -130,13 +130,6 @@ PP(pp_regcomp)
               sv_setsv(tmpstr, sv);
               continue;
            }
-
-           if (SvROK(msv) && SvTYPE(SvRV(msv)) == SVt_REGEXP) {
-               msv = SvRV(msv);
-               PL_reginterp_cnt +=
-                   RX_SEEN_EVALS((REGEXP *)MUTABLE_PTR(msv));
-           }
-
            sv_catsv_nomg(tmpstr, msv);
        }
        SvSETMAGIC(tmpstr);
@@ -212,7 +205,9 @@ PP(pp_regcomp)
            if (PL_op->op_flags & OPf_SPECIAL)
                PL_reginterp_cnt = I32_MAX; /* Mark as safe.  */
 
-           if (!DO_UTF8(tmpstr) && SvUTF8(tmpstr)) {
+           if (DO_UTF8(tmpstr)) {
+               assert (SvUTF8(tmpstr));
+           } else if (SvUTF8(tmpstr)) {
                /* Not doing UTF-8, despite what the SV says. Is this only if
                   we're trapped in use 'bytes'?  */
                /* Make a copy of the octet sequence, but without the flag on,
@@ -221,11 +216,19 @@ PP(pp_regcomp)
                const char *const p = SvPV(tmpstr, len);
                tmpstr = newSVpvn_flags(p, len, SVs_TEMP);
            }
-           else if (SvAMAGIC(tmpstr) || SvGMAGICAL(tmpstr)) {
+           else if (SvAMAGIC(tmpstr)) {
                /* make a copy to avoid extra stringifies */
                tmpstr = newSVpvn_flags(t, len, SVs_TEMP | SvUTF8(tmpstr));
            }
 
+           /* If it is gmagical, create a mortal copy, but without calling
+              get-magic, as we have already done that. */
+           if(SvGMAGICAL(tmpstr)) {
+               SV *mortalcopy = sv_newmortal();
+               sv_setsv_flags(mortalcopy, tmpstr, 0);
+               tmpstr = mortalcopy;
+           }
+
            if (eng)
                PM_SETRE(pm, CALLREGCOMP_ENG(eng, tmpstr, pm_flags));
            else
@@ -302,13 +305,6 @@ PP(pp_substcont)
        s -= RX_GOFS(rx);
 
        /* Are we done */
-       /* I believe that we can't set REXEC_SCREAM here if
-          SvSCREAM(cx->sb_targ) is true because SvPVX(cx->sb_targ) isn't always
-          equal to s.  [See the comment before Perl_re_intuit_start(), which is
-          called from Perl_regexec_flags(), which says that it should be when
-          SvSCREAM() is true.]  s, cx->sb_strend and orig will be consistent
-          with SvPVX(cx->sb_targ), as substconst doesn't modify cx->sb_targ
-          during the match.  */
        if (CxONCE(cx) || s < orig ||
                !CALLREGEXEC(rx, s, cx->sb_strend, orig,
                             (s == m) + RX_GOFS(rx), cx->sb_targ, NULL,
@@ -1898,9 +1894,10 @@ PP(pp_caller)
     }
 
     DEBUG_CX("CALLER");
-    assert(CopSTASHPV(cx->blk_oldcop));
-    assert(SvOOK((HV*)CopSTASH(cx->blk_oldcop)));
-    stash_hek = HvNAME_HEK((HV*)CopSTASH(cx->blk_oldcop));
+    assert(CopSTASH(cx->blk_oldcop));
+    stash_hek = SvTYPE(CopSTASH(cx->blk_oldcop)) == SVt_PVHV
+      ? HvNAME_HEK((HV*)CopSTASH(cx->blk_oldcop))
+      : NULL;
     if (GIMME != G_ARRAY) {
         EXTEND(SP, 1);
        if (!stash_hek)