This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
perlop: Nits
[perl5.git] / regcomp.c
index a3eccfa..0c4dfe7 100644 (file)
--- a/regcomp.c
+++ b/regcomp.c
@@ -6871,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;
        }
@@ -7190,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
@@ -11329,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 '$':
@@ -11341,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 '.':
@@ -11433,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':
@@ -15850,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)
@@ -16213,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);
@@ -16785,17 +16789,6 @@ S_re_croak2(pTHX_ bool utf8, const char* pat1,const char* pat2,...)
     Perl_croak(aTHX_ "%"UTF8f, UTF8fARG(utf8, l1-1, buf));
 }
 
-/* Get this:  We have an empty void function here.  But it somehow got into
-   the API, so there you go.  */
-
-#ifndef PERL_IN_XSUB_RE
-void
-Perl_save_re_context(pTHX)
-{
-    PERL_UNUSED_CONTEXT;
-}
-#endif
-
 #ifdef DEBUGGING
 /* Certain characters are output as a sequence with the first being a
  * backslash. */