[perl #3038] Re: $qr = qr/^a$/m; $x =~ $qr; fails

Message-ID: <20041101034040.GC1232@biff.bort.ca>

p4raw-id: //depot/perl@23471

diff --git a/MANIFEST b/MANIFEST
index e5617e0..c68a5c7 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -2654,6 +2654,7 @@ t/op/recurse.t                    See if deep recursion works
 t/op/ref.t                     See if refs and objects work
 t/op/regexp_noamp.t            See if regular expressions work with optimizations
 t/op/regexp.t                  See if regular expressions work
+t/op/regexp_qr.t               See if regular expressions work as qr//
 t/op/regmesg.t                 See if one can get regular expression errors
 t/op/repeat.t                  See if x operator works
 t/op/re_tests                  Regular expressions for regexp.t

diff --git a/pp.c b/pp.c
index 94a278a..2584882 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -4454,6 +4454,7 @@ PP(pp_split)
     I32 gimme = GIMME_V;
     I32 oldsave = PL_savestack_ix;
     I32 make_mortal = 1;
+    bool multiline = 0;
     MAGIC *mg = (MAGIC *) NULL;
 
 #ifdef DEBUGGING
@@ -4515,9 +4516,8 @@ PP(pp_split)
                s++;
        }
     }
-    if ((int)(pm->op_pmflags & PMf_MULTILINE) != PL_multiline) {
-       SAVEINT(PL_multiline);
-       PL_multiline = pm->op_pmflags & PMf_MULTILINE;
+    if (pm->op_pmflags & PMf_MULTILINE) {
+       multiline = 1;
     }
 
     if (!limit)
@@ -4599,7 +4599,7 @@ PP(pp_split)
 #ifndef lint
            while (s < strend && --limit &&
              (m = fbm_instr((unsigned char*)s, (unsigned char*)strend,
-                            csv, PL_multiline ? FBMrf_MULTILINE : 0)) )
+                            csv, multiline ? FBMrf_MULTILINE : 0)) )
 #endif
            {
                dstr = NEWSV(31, m-s);

diff --git a/pp_hot.c b/pp_hot.c
index 1054d1d..e41ee3d 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -1274,11 +1274,6 @@ PP(pp_match)
     if (SvSCREAM(TARG))
        r_flags |= REXEC_SCREAM;
 
-    if ((int)(pm->op_pmflags & PMf_MULTILINE) != PL_multiline) {
-       SAVEINT(PL_multiline);
-       PL_multiline = pm->op_pmflags & PMf_MULTILINE;
-    }
-
 play_it_again:
     if (global && rx->startp[0] != -1) {
        t = s = rx->endp[0] + truebase;
@@ -2056,10 +2051,7 @@ PP(pp_subst)
               ? REXEC_COPY_STR : 0;
     if (SvSCREAM(TARG))
        r_flags |= REXEC_SCREAM;
-    if ((int)(pm->op_pmflags & PMf_MULTILINE) != PL_multiline) {
-       SAVEINT(PL_multiline);
-       PL_multiline = pm->op_pmflags & PMf_MULTILINE;
-    }
+
     orig = m = s;
     if (rx->reganch & RE_USE_INTUIT) {
        PL_bostr = orig;

diff --git a/regexec.c b/regexec.c
index e843478..fd3bc05 100644 (file)
--- a/regexec.c
+++ b/regexec.c
@@ -403,6 +403,7 @@ Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos,
     I32 ml_anch;
     register char *other_last = Nullch;        /* other substr checked before this */
     char *check_at = Nullch;           /* check substr found at this pos */
+    I32 multiline = prog->reganch & PMf_MULTILINE;
 #ifdef DEBUGGING
     char *i_strpos = strpos;
     SV *dsv = PERL_DEBUG_PAD_ZERO(0);
@@ -464,7 +465,7 @@ Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos,
     if (prog->reganch & ROPT_ANCH) {   /* Match at beg-of-str or after \n */
        ml_anch = !( (prog->reganch & ROPT_ANCH_SINGLE)
                     || ( (prog->reganch & ROPT_ANCH_BOL)
-                         && !PL_multiline ) ); /* Check after \n? */
+                         && !multiline ) );    /* Check after \n? */
 
        if (!ml_anch) {
          if ( !(prog->reganch & (ROPT_ANCH_GPOS /* Checked by the caller */
@@ -558,11 +559,11 @@ Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos,
     else if (prog->reganch & ROPT_CANY_SEEN)
        s = fbm_instr((U8*)(s + start_shift),
                      (U8*)(strend - end_shift),
-                     check, PL_multiline ? FBMrf_MULTILINE : 0);
+                     check, multiline ? FBMrf_MULTILINE : 0);
     else
        s = fbm_instr(HOP3(s, start_shift, strend),
                      HOP3(strend, -end_shift, strbeg),
-                     check, PL_multiline ? FBMrf_MULTILINE : 0);
+                     check, multiline ? FBMrf_MULTILINE : 0);
 
     /* Update the count-of-usability, remove useless subpatterns,
        unshift s.  */
@@ -631,7 +632,7 @@ Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos,
                        HOP3(HOP3(last1, prog->anchored_offset, strend)
                                + SvCUR(must), -(SvTAIL(must)!=0), strbeg),
                        must,
-                       PL_multiline ? FBMrf_MULTILINE : 0
+                       multiline ? FBMrf_MULTILINE : 0
                    );
                DEBUG_r(PerlIO_printf(Perl_debug_log,
                        "%s anchored substr `%s%.*s%s'%s",
@@ -692,7 +693,7 @@ Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos,
                s = fbm_instr((unsigned char*)s,
                              (unsigned char*)last + SvCUR(must)
                                  - (SvTAIL(must)!=0),
-                             must, PL_multiline ? FBMrf_MULTILINE : 0);
+                             must, multiline ? FBMrf_MULTILINE : 0);
            DEBUG_r(PerlIO_printf(Perl_debug_log, "%s floating substr `%s%.*s%s'%s",
                    (s ? "Found" : "Contradicts"),
                    PL_colors[0],
@@ -1628,6 +1629,7 @@ Perl_regexec_flags(pTHX_ register regexp *prog, char *stringarg, register char *
     char *scream_olds;
     SV* oreplsv = GvSV(PL_replgv);
     bool do_utf8 = DO_UTF8(sv);
+    I32 multiline = prog->reganch & PMf_MULTILINE;
 #ifdef DEBUGGING
     SV *dsv0 = PERL_DEBUG_PAD_ZERO(0);
     SV *dsv1 = PERL_DEBUG_PAD_ZERO(1);
@@ -1744,7 +1746,7 @@ Perl_regexec_flags(pTHX_ register regexp *prog, char *stringarg, register char *
     if (prog->reganch & (ROPT_ANCH & ~ROPT_ANCH_GPOS)) {
        if (s == startpos && regtry(prog, startpos))
            goto got_it;
-       else if (PL_multiline || (prog->reganch & ROPT_IMPLICIT)
+       else if (multiline || (prog->reganch & ROPT_IMPLICIT)
                 || (prog->reganch & ROPT_ANCH_MBOL)) /* XXXX SBOL? */
        {
            char *end;
@@ -1878,7 +1880,7 @@ Perl_regexec_flags(pTHX_ register regexp *prog, char *stringarg, register char *
                                    end_shift, &scream_pos, 0))
                 : (s = fbm_instr((unsigned char*)HOP3(s, back_min, strend),
                                  (unsigned char*)strend, must,
-                                 PL_multiline ? FBMrf_MULTILINE : 0))) ) {
+                                 multiline ? FBMrf_MULTILINE : 0))) ) {
            /* we may be pointing at the wrong string */
            if ((flags & REXEC_SCREAM) && RX_MATCH_COPIED(prog))
                s = strbeg + (s - SvPVX(sv));
@@ -1979,7 +1981,7 @@ Perl_regexec_flags(pTHX_ register regexp *prog, char *stringarg, register char *
                if (SvTAIL(float_real)) {
                    if (memEQ(strend - len + 1, little, len - 1))
                        last = strend - len + 1;
-                   else if (!PL_multiline)
+                   else if (!multiline)
                        last = memEQ(strend - len, little, len)
                            ? strend - len : Nullch;
                    else
@@ -2369,8 +2371,7 @@ S_regmatch(pTHX_ regnode *prog)
 
        switch (OP(scan)) {
        case BOL:
-           if (locinput == PL_bostr || (PL_multiline &&
-               (nextchr || locinput < PL_regeol) && locinput[-1] == '\n') )
+           if (locinput == PL_bostr)
            {
                /* regtill = regbol; */
                break;
@@ -2392,12 +2393,8 @@ S_regmatch(pTHX_ regnode *prog)
                break;
            sayNO;
        case EOL:
-           if (PL_multiline)
-               goto meol;
-           else
                goto seol;
        case MEOL:
-         meol:
            if ((nextchr || locinput < PL_regeol) && nextchr != '\n')
                sayNO;
            break;
@@ -3734,7 +3731,7 @@ S_regmatch(pTHX_ regnode *prog)
                n = regrepeat(scan, n);
                locinput = PL_reginput;
                if (ln < n && PL_regkind[(U8)OP(next)] == EOL &&
-                   ((!PL_multiline && OP(next) != MEOL) ||
+                   (OP(next) != MEOL ||
                        OP(next) == SEOL || OP(next) == EOS))
                {
                    ln = n;                     /* why back off? */

diff --git a/t/op/regexp.t b/t/op/regexp.t
index 3cebee9..b4288b2 100755 (executable)
--- a/t/op/regexp.t
+++ b/t/op/regexp.t
@@ -49,6 +49,7 @@ $. = 0;
 $bang = sprintf "\\%03o", ord "!"; # \41 would not be portable.
 $ffff  = chr(0xff) x 2;
 $nulnul = "\0" x 2;
+$OP = $qr ? 'qr' : 'm';
 
 $| = 1;
 print "1..$numtests\n# $iters iterations\n";
@@ -73,7 +74,7 @@ while (<TESTS>) {
     $result =~ s/B//i unless $skip;
     for $study ('', 'study \$subject') {
        $c = $iters;
-       eval "$study; \$match = (\$subject =~ m$pat) while \$c--; \$got = \"$repl\";";
+       eval "$study; \$match = (\$subject =~ $OP$pat) while \$c--; \$got = \"$repl\";";
        chomp( $err = $@ );
        if ($result eq 'c') {
            if ($err !~ m!^\Q$expect!) { print "not ok $. (compile) $input => `$err'\n"; next TEST }

diff --git a/t/op/regexp_qr.t b/t/op/regexp_qr.t
new file mode 100644 (file)
index 0000000..ed38822
--- /dev/null
+++ b/t/op/regexp_qr.t
@@ -0,0 +1,10 @@
+#!./perl
+
+$qr = 1;
+for $file ('./op/regexp.t', './t/op/regexp.t', ':op:regexp.t') {
+    if (-r $file) {
+       do $file;
+       exit;
+    }
+}
+die "Cannot find ./op/regexp.t or ./t/op/regexp.t\n";