From: Rick Delaney Date: Sun, 31 Oct 2004 22:40:40 +0000 (-0500) Subject: [perl #3038] Re: $qr = qr/^a$/m; $x =~ $qr; fails X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=7fba1cd64145def991b6ae509bcdd709edcf43c1;p=p5sagit%2Fp5-mst-13.2.git [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 --- 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 --- 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 --- 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 --- 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 --- 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 () { $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 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";