qr/(.$)/m not the same as /(?m-xis:(.$))/ with /g #1783
Comments
From rick@consumercontact.comI expect "with qr" should behave like "without qr" below. #!/opt/perl/bin/perl -lw $_ = <<C; my $pat = '(.$)'; print "Matching /$str/ without qr"; __END__ With -Dr: EXECUTING... Compiling REx `(.$)' Compiling REx `(?m-xis:(.$))' [rest trimmed] Flags: Site configuration information for perl v5.6.0: Configured by rick at Fri Mar 31 17:49:37 EST 2000. Summary of my perl5 (revision 5.0 version 6 subversion 0) configuration: Locally applied patches: @INC for perl v5.6.0: Environment for perl v5.6.0: |
From [Unknown Contact. See original ticket]Rick Delaney writes:
Interesting. The opcode trees coincide, but the sniffer deduces Ilya |
From rick@bort.caOn Wed, Oct 27, 2004 at 07:52:39PM -0400, Stas Bekman wrote:
Well, I guess that's long enough then, especially since that's one of I thought I'd get rid of PL_multiline while I was at it (since $* is now What is pp_cswitch and why is it using PL_multiline? It's commented out I also noticed this in regexp.h while trying to track this bug down: #define ROPT_CANY_SEEN 0x00800 /* 0xf800 of reganch is used by PMf_COMPILETIME */ It looks like PMf_COMPILETIME overlaps with ROPT_CANY_SEEN, specifically All tests pass, plus the new ones which, thankfully, I only had to find. -- Inline Patchdiff -purN perl-current/pp.c perl-current-dev/pp.c
--- perl-current/pp.c Thu Sep 30 17:16:36 2004
+++ perl-current-dev/pp.c Sun Oct 31 22:17:18 2004
@@ -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 -purN perl-current/pp_hot.c perl-current-dev/pp_hot.c
--- perl-current/pp_hot.c Wed Sep 8 13:10:42 2004
+++ perl-current-dev/pp_hot.c Sun Oct 31 22:17:42 2004
@@ -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 -purN perl-current/regexec.c perl-current-dev/regexec.c
--- perl-current/regexec.c Sun Aug 1 13:10:49 2004
+++ perl-current-dev/regexec.c Sun Oct 31 22:17:57 2004
@@ -403,6 +403,7 @@ Perl_re_intuit_start(pTHX_ regexp *prog,
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,
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,
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,
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,
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
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
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
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
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 -purN perl-current/t/op/regexp.t perl-current-dev/t/op/regexp.t
--- perl-current/t/op/regexp.t Sat Oct 27 14:11:46 2001
+++ perl-current-dev/t/op/regexp.t Sun Oct 31 22:19:48 2004
@@ -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 -purN perl-current/t/op/regexp_qr.t perl-current-dev/t/op/regexp_qr.t
--- perl-current/t/op/regexp_qr.t Wed Dec 31 19:00:00 1969
+++ perl-current-dev/t/op/regexp_qr.t Sun Oct 31 22:19:13 2004
@@ -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"; |
From @rgsRick Delaney wrote:
Good idea, this was on my plans :)
pp_cswitch is not compiled (it's inside an #ifdef NOTYET). As perltodo says : The old perltodo notes "Although we have C<Switch.pm> in core, Larry
Er, regex wizard to comment ? -- |
From @rgsRick Delaney wrote:
Thanks, applied as #23471. |
|
@smpeters - Status changed from 'open' to 'resolved' |
From @nwc10This patch: On Thu, Nov 04, 2004 at 02:59:25AM -0800, Rafael Garcia-Suarez wrote:
(full patch here http://public.activestate.com/cgi-bin/perlbrowse?patch=23471 ) conflicts on maint:
==== THEIRS pp_hot.c#361 <<<<
==== YOURS pp_hot.c Is it suitable for maint? And if so, what's the correct patch for maint? I presume that the conflicts are due to the removal of $* from blead: http://public.activestate.com/cgi-bin/perlbrowse?patch=19769 Nicholas Clark |
From rick@bort.caOn Wed, Dec 01, 2004 at 03:40:44PM +0000, Nicholas Clark wrote:
Sorry, I have no spare tuits for a maint patch, but quickly...
These two files should be left alone:
Look for the ****: ==== //depot/perl/regexec.c#325 (text) ==== @@ -403,6 +403,7 @@ **** above should be something like #ifdef DEBUGGING if (!ml_anch) { /* Update the count-of-usability, remove useless subpatterns, **** above should be something like #ifdef DEBUGGING **** The following changes in this file would not be suitable for maint: switch (OP(scan)) {
Yep. I think that should do it; the new tests should tell you. HTH, -- |
From @nwc10On Thu, Dec 02, 2004 at 01:20:28PM -0500, Rick Delaney wrote:
Yes, bang on. Sorry that it's taken so long (and a really big tuit) to make the time to do Nicholas Clark |
See issue #39 and Perl/perl5#1783
|
but why is this created in 2000-2006 I thought github released in 2008 |
|
It was created in RT in 2000. The ticket has been migrated to github with the dates preserved. We actually have tickets migrated from the system before RT into RT, that have then been migrated to github... We also have git history from before git existed (imported from perforce, and even recreated from datestamps on earlier public releases). |
Migrated from rt.perl.org#3038 (status was 'resolved')
Searchable as RT3038$
The text was updated successfully, but these errors were encountered: