perlop: Nits

[perl5.git] / regcomp.c

diff --git a/regcomp.c b/regcomp.c
index ba51612..0c4dfe7 100644 (file)
--- a/regcomp.c
+++ b/regcomp.c
@@ -6054,7 +6054,6 @@ S_compile_runtime_code(pTHX_ RExC_state_t * const pRExC_state,
 
        ENTER;
        SAVETMPS;
-       save_re_context();
        PUSHSTACKi(PERLSI_REQUIRE);
         /* G_RE_REPARSING causes the toker to collapse \\ into \ when
          * parsing qr''; normally only q'' does this. It also alters
@@ -6872,9 +6871,7 @@ reStudy:
        else if (PL_regkind[OP(first)] == BOL) {
             r->intflags |= (OP(first) == MBOL
                            ? PREGf_ANCH_MBOL
-                          : (OP(first) == SBOL
-                              ? PREGf_ANCH_SBOL
-                              : PREGf_ANCH_BOL));
+                           : PREGf_ANCH_SBOL);
            first = NEXTOPER(first);
            goto again;
        }
@@ -7191,7 +7188,12 @@ reStudy:
 
         if (PL_regkind[fop] == NOTHING && nop == END)
             r->extflags |= RXf_NULL;
-        else if (PL_regkind[fop] == BOL && nop == END)
+        else if ((fop == MBOL || (fop == SBOL && !first->flags)) && nop == END)
+            /* when fop is SBOL first->flags will be true only when it was
+             * produced by parsing /\A/, and not when parsing /^/. This is
+             * very important for the split code as there we want to
+             * treat /^/ as /^/m, but we do not want to treat /\A/ as /^/m.
+             * See rt #122761 for more details. -- Yves */
             r->extflags |= RXf_START_ONLY;
         else if (fop == PLUS
                  && PL_regkind[nop] == POSIXD && FLAGS(next) == _CC_SPACE
@@ -11330,10 +11332,8 @@ tryagain:
        nextchar(pRExC_state);
        if (RExC_flags & RXf_PMf_MULTILINE)
            ret = reg_node(pRExC_state, MBOL);
-       else if (RExC_flags & RXf_PMf_SINGLELINE)
-           ret = reg_node(pRExC_state, SBOL);
        else
-           ret = reg_node(pRExC_state, BOL);
+           ret = reg_node(pRExC_state, SBOL);
         Set_Node_Length(ret, 1); /* MJD */
        break;
     case '$':
@@ -11342,10 +11342,8 @@ tryagain:
            RExC_seen_zerolen++;
        if (RExC_flags & RXf_PMf_MULTILINE)
            ret = reg_node(pRExC_state, MEOL);
-       else if (RExC_flags & RXf_PMf_SINGLELINE)
-           ret = reg_node(pRExC_state, SEOL);
        else
-           ret = reg_node(pRExC_state, EOL);
+           ret = reg_node(pRExC_state, SEOL);
         Set_Node_Length(ret, 1); /* MJD */
        break;
     case '.':
@@ -11434,6 +11432,11 @@ tryagain:
        case 'A':
            RExC_seen_zerolen++;
            ret = reg_node(pRExC_state, SBOL);
+            /* SBOL is shared with /^/ so we set the flags so we can tell
+             * /\A/ from /^/ in split. We check ret because first pass we
+             * have no regop struct to set the flags on. */
+            if (PASS2)
+                ret->flags = 1;
            *flagp |= SIMPLE;
            goto finish_meta_pat;
        case 'G':
@@ -14370,6 +14373,7 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth,
        RExC_parse = SvPV(substitute_parse, len);
        RExC_end = RExC_parse + len;
         RExC_in_multi_char_class = 1;
+       RExC_override_recoding = 1;
         RExC_emit = (regnode *)orig_emit;
 
        ret = reg(pRExC_state, 1, &reg_flags, depth+1);
@@ -14379,6 +14383,7 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth,
        RExC_parse = save_parse;
        RExC_end = save_end;
        RExC_in_multi_char_class = 0;
+       RExC_override_recoding = 0;
         SvREFCNT_dec_NN(multi_char_matches);
         return ret;
     }
@@ -15849,8 +15854,6 @@ Perl_regdump(pTHX_ const regexp *r)
     }
     if (r->intflags & PREGf_ANCH) {
        PerlIO_printf(Perl_debug_log, "anchored");
-        if (r->intflags & PREGf_ANCH_BOL)
-           PerlIO_printf(Perl_debug_log, "(BOL)");
         if (r->intflags & PREGf_ANCH_MBOL)
            PerlIO_printf(Perl_debug_log, "(MBOL)");
         if (r->intflags & PREGf_ANCH_SBOL)
@@ -16212,6 +16215,8 @@ Perl_regprop(pTHX_ const regexp *prog, SV *sv, const regnode *o, const regmatch_
     }
     else if (k == BRANCHJ && (OP(o) == UNLESSM || OP(o) == IFMATCH))
        Perl_sv_catpvf(aTHX_ sv, "[%d]", -(o->flags));
+    else if (OP(o) == SBOL)
+        Perl_sv_catpvf(aTHX_ sv, " /%s/", o->flags ? "\\A" : "^");
 #else
     PERL_UNUSED_CONTEXT;
     PERL_UNUSED_ARG(sv);
@@ -16784,35 +16789,6 @@ S_re_croak2(pTHX_ bool utf8, const char* pat1,const char* pat2,...)
     Perl_croak(aTHX_ "%"UTF8f, UTF8fARG(utf8, l1-1, buf));
 }
 
-/* XXX Here's a total kludge.  But we need to re-enter for swash routines. */
-
-#ifndef PERL_IN_XSUB_RE
-void
-Perl_save_re_context(pTHX)
-{
-    /* Save $1..$n (#18107: UTF-8 s/(\w+)/uc($1)/e); AMS 20021106. */
-    if (PL_curpm) {
-       const REGEXP * const rx = PM_GETRE(PL_curpm);
-       if (rx) {
-           U32 i;
-           for (i = 1; i <= RX_NPARENS(rx); i++) {
-               char digits[TYPE_CHARS(long)];
-               const STRLEN len = my_snprintf(digits, sizeof(digits),
-                                               "%lu", (long)i);
-               GV *const *const gvp
-                   = (GV**)hv_fetch(PL_defstash, digits, len, 0);
-
-               if (gvp) {
-                   GV * const gv = *gvp;
-                   if (SvTYPE(gv) == SVt_PVGV && GvSV(gv))
-                       save_scalar(gv);
-               }
-           }
-       }
-    }
-}
-#endif
-
 #ifdef DEBUGGING
 /* Certain characters are output as a sequence with the first being a
  * backslash. */