Revert 4 regex commits to ease rebasing

[perl5.git] / pp_ctl.c

diff --git a/pp_ctl.c b/pp_ctl.c
index 8f4c103..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,
@@ -1897,7 +1893,11 @@ PP(pp_caller)
        RETURN;
     }
 
-    stash_hek = HvNAME_HEK((HV*)CopSTASH(cx->blk_oldcop));
+    DEBUG_CX("CALLER");
+    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)
@@ -2370,13 +2370,24 @@ S_return_lvalues(pTHX_ SV **mark, SV **sp, SV **newsp, I32 gimme,
        if (MARK < SP) {
              copy_sv:
                if (cx->blk_sub.cv && CvDEPTH(cx->blk_sub.cv) > 1) {
+                   if (!SvPADTMP(*SP)) {
                        *++newsp = SvREFCNT_inc(*SP);
                        FREETMPS;
                        sv_2mortal(*newsp);
+                   }
+                   else {
+                       /* FREETMPS could clobber it */
+                       SV *sv = SvREFCNT_inc(*SP);
+                       FREETMPS;
+                       *++newsp = sv_mortalcopy(sv);
+                       SvREFCNT_dec(sv);
+                   }
                }
                else
                    *++newsp =
-                       !SvTEMP(*SP)
+                     SvPADTMP(*SP)
+                      ? sv_mortalcopy(*SP)
+                      : !SvTEMP(*SP)
                          ? sv_2mortal(SvREFCNT_inc_simple_NN(*SP))
                          : *SP;
        }
@@ -2396,10 +2407,10 @@ S_return_lvalues(pTHX_ SV **mark, SV **sp, SV **newsp, I32 gimme,
        if (ref || !CxLVAL(cx))
            while (++MARK <= SP)
                *++newsp =
-                    SvTEMP(*MARK)
-                      ? *MARK
-                      : ref && SvFLAGS(*MARK) & SVs_PADTMP
+                      SvFLAGS(*MARK) & SVs_PADTMP
                           ? sv_mortalcopy(*MARK)
+                    : SvTEMP(*MARK)
+                          ? *MARK
                           : sv_2mortal(SvREFCNT_inc_simple_NN(*MARK));
        else while (++MARK <= SP) {
            if (*MARK != &PL_sv_undef
@@ -3044,23 +3055,18 @@ PP(pp_goto)
        else {
            label       = SvPV_const(sv, label_len);
             label_flags = SvUTF8(sv);
-           if (!(do_dump || *label))
-               DIE(aTHX_ must_have_label);
        }
     }
-    else if (PL_op->op_flags & OPf_SPECIAL) {
-       if (! do_dump)
-           DIE(aTHX_ must_have_label);
-    }
-    else {
+    else if (!(PL_op->op_flags & OPf_SPECIAL)) {
        label       = cPVOP->op_pv;
         label_flags = (cPVOP->op_private & OPpPV_IS_UTF8) ? SVf_UTF8 : 0;
         label_len   = strlen(label);
     }
+    if (!(do_dump || label_len)) DIE(aTHX_ must_have_label);
 
     PERL_ASYNC_CHECK();
 
-    if (label && *label) {
+    if (label_len) {
        OP *gotoprobe = NULL;
        bool leaving_eval = FALSE;
        bool in_block = FALSE;
@@ -5659,8 +5665,8 @@ S_path_is_absolute(const char *name)
  * Local variables:
  * c-indentation-style: bsd
  * c-basic-offset: 4
- * indent-tabs-mode: t
+ * indent-tabs-mode: nil
  * End:
  *
- * ex: set ts=8 sts=4 sw=4 noet:
+ * ex: set ts=8 sts=4 sw=4 et:
  */