qr/(.$)/m not the same as /(?m-xis:(.$))/ with /g

[p5pRT]

Migrated from rt.perl.org#3038 (status was 'resolved')

Searchable as RT3038$

[p5pRT]

From rick@consumercontact.com

I expect "with qr" should behave like "without qr" below.

#!/opt/perl/bin/perl -lw

$_ = <<C;
A
B
C

my $pat = '(.$)';
my $str = "(?m-xis​:$pat)";
my $RE = qr/$pat/m;

print "Matching /$str/ without qr";
print $1 while /$str/g;
print "Matching /$RE/ with qr";
print $1 while /$RE/g;

__END__
Matching /(?m-xis​:(.$))/ without qr
A
B
Matching /(?m-xis​:(.$))/ with qr
B

With -Dr​:

EXECUTING...

Compiling REx `(.$)'
size 7 first at 3
rarest char
at 0
  1​: OPEN1(3)
  3​: REG_ANY(4)
  4​: MEOL(5)
  5​: CLOSE1(7)
  7​: END(0)
anchored `'$ at 1 minlen 1

Compiling REx `(?m-xis​:(.$))'
size 7 first at 3
  1​: OPEN1(3)
  3​: REG_ANY(4)
  4​: MEOL(5)
  5​: CLOSE1(7)
  7​: END(0)
minlen 1

[rest trimmed]

---

Flags​:
  category=core
  severity=low

---

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​:
  Platform​:
  osname=svr4, osvers=, archname=i386-svr4
  uname='unix_sv consumer 4.2mp 2.1.3 i386 x86at '
  config_args='-Dprefix=/opt/perl -Doptimize=-g'
  hint=recommended, useposix=true, d_sigaction=define
  usethreads=undef use5005threads=undef useithreads=undef usemultiplicity=undef
  useperlio=undef d_sfio=undef uselargefiles=define
  use64bitint=undef use64bitall=undef uselongdouble=undef usesocks=undef
  Compiler​:
  cc='/bin/cc', optimize='-g', gccversion=
  cppflags='-I/usr/include -I/usr/ucbinclude -DDEBUGGING -I/usr/local/include'
  ccflags ='-I/usr/include -I/usr/ucbinclude -DDEBUGGING -I/usr/local/include'
  stdchar='unsigned char', d_stdstdio=define, usevfork=false
  intsize=4, longsize=4, ptrsize=4, doublesize=8
  d_longlong=undef, longlongsize=, d_longdbl=define, longdblsize=12
  ivtype='long', ivsize=4, nvtype='double', nvsize=8, Off_t='off_t', lseeksize=4
  alignbytes=4, usemymalloc=y, prototype=define
  Linker and Libraries​:
  ld='/bin/cc', ldflags ='-L/usr/ccs/lib -L/usr/ucblib -L/usr/local/lib -L/usr/gnu/lib'
  libpth=/usr/local/lib /usr/gnu/lib /shlib /lib /usr/lib /usr/ccs/lib /usr/ucblib
  libs=-lsocket -lnsl -ldbm -ldb -ldl -lld -lm -lc -lcrypt -lucb
  libc=, so=so, useshrplib=true, libperl=libperl.so
  Dynamic Linking​:
  dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=undef, ccdlflags=' '
  cccdlflags='-KPIC', lddlflags='-G -L/usr/ccs/lib -L/usr/ucblib -L/usr/local/lib -L/usr/gnu/lib'

Locally applied patches​:
 

---

@​INC for perl v5.6.0​:
  /opt/perl/lib/5.6.0/i386-svr4
  /opt/perl/lib/5.6.0
  /opt/perl/lib/site_perl/5.6.0/i386-svr4
  /opt/perl/lib/site_perl/5.6.0
  /opt/perl/lib/site_perl
  .

---

Environment for perl v5.6.0​:
  HOME=/home1/rick
  LANG=C
  LANGUAGE (unset)
  LD_LIBRARY_PATH=/data1/systems/dev/perl-5.6.0​:/usr/opt/dash/lib​:.​:/lib​:/usr/lib​:/usr/lib/ARCserve
  LOGDIR (unset)
  PATH=/bin​:/usr/bin​:/opt/perl/bin
  PERL_BADLANG (unset)
  SHELL=/usr/bin/ksh

[p5pRT]

From [Unknown Contact. See original ticket]

Rick Delaney writes​:

my $pat = '(.$)';
my $str = "(?m-xis​:$pat)";
my $RE = qr/$pat/m;

Compiling REx `(.$)'
size 7 first at 3
rarest char
at 0
1​: OPEN1(3)
3​: REG_ANY(4)
4​: MEOL(5)
5​: CLOSE1(7)
7​: END(0)
anchored `'$ at 1 minlen 1

Compiling REx `(?m-xis​:(.$))'
size 7 first at 3
1​: OPEN1(3)
3​: REG_ANY(4)
4​: MEOL(5)
5​: CLOSE1(7)
7​: END(0)
minlen 1

Interesting. The opcode trees coincide, but the sniffer deduces
different information for the REx match optimizer. Given that the
sniffer works over the trees, mind boggles...

Ilya

[p5pRT]

From rick@bort.ca

On Wed, Oct 27, 2004 at 07​:52​:39PM -0400, Stas Bekman wrote​:

issues. Perlbug #7781 discuss an almost identical problem as seen Stas
was demonstrating on #p5p.

Thanks for the research, Steve. As it looks #3038 was reported 4.5 years
ago...

Well, I guess that's long enough then, especially since that's one of
mine.

I thought I'd get rid of PL_multiline while I was at it (since $* is now
gone) but I was afraid to go too far.

What is pp_cswitch and why is it using PL_multiline? It's commented out
in opcode.pl.

I also noticed this in regexp.h while trying to track this bug down​:

#define ROPT_CANY_SEEN 0x00800
#define ROPT_SANY_SEEN ROPT_CANY_SEEN /* src bckwrd cmpt */

/* 0xf800 of reganch is used by PMf_COMPILETIME */

It looks like PMf_COMPILETIME overlaps with ROPT_CANY_SEEN, specifically
the PMf_LOCALE portion. I don't know what ROPT_CANY_SEEN is; is this ok?
It doesn't look it.

All tests pass, plus the new ones which, thankfully, I only had to find.

--
Rick Delaney
rick@​bort.ca

Inline Patch

diff -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";

[p5pRT]

From @rgs

Rick Delaney wrote​:

I thought I'd get rid of PL_multiline while I was at it (since $* is now
gone) but I was afraid to go too far.

Good idea, this was on my plans :)

What is pp_cswitch and why is it using PL_multiline? It's commented out
in opcode.pl.

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
  points to the dormant C<nswitch> and C<cswitch> ops in F<pp.c>;
  using these opcodes would be much faster."

I also noticed this in regexp.h while trying to track this bug down​:

#define ROPT_CANY_SEEN 0x00800
#define ROPT_SANY_SEEN ROPT_CANY_SEEN /* src bckwrd cmpt */

/* 0xf800 of reganch is used by PMf_COMPILETIME */

It looks like PMf_COMPILETIME overlaps with ROPT_CANY_SEEN, specifically
the PMf_LOCALE portion. I don't know what ROPT_CANY_SEEN is; is this ok?
It doesn't look it.

Er, regex wizard to comment ?

--
A seventh gravedigger came beside Mr Bloom to take up an idle spade.
  -- Ulysses

[p5pRT]

From @rgs

Rick Delaney wrote​:

On Wed, Oct 27, 2004 at 07​:52​:39PM -0400, Stas Bekman wrote​:

issues. Perlbug #7781 discuss an almost identical problem as seen Stas
was demonstrating on #p5p.

Thanks for the research, Steve. As it looks #3038 was reported 4.5 years
ago...

Well, I guess that's long enough then, especially since that's one of
mine.

I thought I'd get rid of PL_multiline while I was at it (since $* is now
gone) but I was afraid to go too far.

All tests pass, plus the new ones which, thankfully, I only had to find.

Thanks, applied as #23471.

[p5pRT]

@smpeters - Status changed from 'open' to 'resolved'

[p5pRT]

From @nwc10

This patch​:

On Thu, Nov 04, 2004 at 02​:59​:25AM -0800, Rafael Garcia-Suarez wrote​:

Change 23471 by rgs@​valis on 2004/11/04 09​:26​:56

Subject​: \[PATCH blead\] \[perl \#3038\] Re​: $qr = qr/^a$/m; $x =~ $qr; fails
From&#8203;: Rick Delaney \<rick@&#8203;bort\.ca>
Date&#8203;: Sun\, 31 Oct 2004 22&#8203;:40&#8203;:40 \-0500
Message\-ID&#8203;: \<20041101034040\.GC1232@&#8203;biff\.bort\.ca>

Affected files ...

... //depot/perl/MANIFEST#1191 edit
... //depot/perl/pp.c#427 edit
... //depot/perl/pp_hot.c#361 edit
... //depot/perl/regexec.c#325 edit
... //depot/perl/t/op/regexp.t#33 edit
... //depot/perl/t/op/regexp_qr.t#1 add

(full patch here http​://public.activestate.com/cgi-bin/perlbrowse?patch=23471 )

conflicts on maint​:

ORIGINAL pp.c#426
  if ((int)(pm->op_pmflags & PMf_MULTILINE) != PL_multiline) {
  SAVEINT(PL_multiline);
  PL_multiline = pm->op_pmflags & PMf_MULTILINE;
==== THEIRS pp.c#427
  if (pm->op_pmflags & PMf_MULTILINE) {
  multiline = 1;
==== YOURS pp.c
  if (pm->op_pmflags & (PMf_MULTILINE|PMf_SINGLELINE)) {
  SAVEINT(PL_multiline);
  PL_multiline = pm->op_pmflags & PMf_MULTILINE;
<<<<

ORIGINAL pp_hot.c#360
  if ((int)(pm->op_pmflags & PMf_MULTILINE) != PL_multiline) {
  SAVEINT(PL_multiline);
  PL_multiline = pm->op_pmflags & PMf_MULTILINE;
  }

==== THEIRS pp_hot.c#361
==== YOURS pp_hot.c
  if (pm->op_pmflags & (PMf_MULTILINE|PMf_SINGLELINE)) {
  SAVEINT(PL_multiline);
  PL_multiline = pm->op_pmflags & PMf_MULTILINE;
  }

<<<<

ORIGINAL pp_hot.c#360
  if ((int)(pm->op_pmflags & PMf_MULTILINE) != PL_multiline) {
  SAVEINT(PL_multiline);
  PL_multiline = pm->op_pmflags & PMf_MULTILINE;
  }
==== THEIRS pp_hot.c#361

==== YOURS pp_hot.c
  if (pm->op_pmflags & (PMf_MULTILINE|PMf_SINGLELINE)) {
  SAVEINT(PL_multiline);
  PL_multiline = pm->op_pmflags & PMf_MULTILINE;
  }
<<<<

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

[p5pRT]

From rick@bort.ca

On Wed, Dec 01, 2004 at 03​:40​:44PM +0000, Nicholas Clark wrote​:

This patch​:

On Thu, Nov 04, 2004 at 02​:59​:25AM -0800, Rafael Garcia-Suarez wrote​:

Change 23471 by rgs@​valis on 2004/11/04 09​:26​:56

Subject​: \[PATCH blead\] \[perl \#3038\] Re​: $qr = qr/^a$/m; $x =~ $qr; fails
From&#8203;: Rick Delaney \<rick@&#8203;bort\.ca>
Date&#8203;: Sun\, 31 Oct 2004 22&#8203;:40&#8203;:40 \-0500
Message\-ID&#8203;: \<20041101034040\.GC1232@&#8203;biff\.bort\.ca>

Sorry, I have no spare tuits for a maint patch, but quickly...

Affected files ...

... //depot/perl/MANIFEST#1191 edit

These two files should be left alone​:

... //depot/perl/pp.c#427 edit
... //depot/perl/pp_hot.c#361 edit

... //depot/perl/regexec.c#325 edit
... //depot/perl/t/op/regexp.t#33 edit
... //depot/perl/t/op/regexp_qr.t#1 add

(full patch here http​://public.activestate.com/cgi-bin/perlbrowse?patch=23471 )
[snip]
Is it suitable for maint? And if so, what's the correct patch for maint?

Look for the ****​:

==== //depot/perl/regexec.c#325 (text) ====

@​@​ -403,6 +403,7 @​@​
  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;

**** above should be something like
+ I32 multiline = PL_multiline | (prog->reganch & PMf_MULTILINE);

#ifdef DEBUGGING
  char *i_strpos = strpos;
  SV *dsv = PERL_DEBUG_PAD_ZERO(0);
@​@​ -464,7 +465,7 @​@​
  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 @​@​
  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 @​@​
  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 @​@​
  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 @​@​
  char *scream_olds;
  SV* oreplsv = GvSV(PL_replgv);
  bool do_utf8 = DO_UTF8(sv);
+ I32 multiline = prog->reganch & PMf_MULTILINE;

**** above should be something like
+ I32 multiline = PL_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 @​@​
  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 @​@​
  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 @​@​
  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 @​@​

**** The following changes in this file would not be suitable for maint​:

  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 @​@​
  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 @​@​
  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? */

I presume that the conflicts are due to the removal of $* from blead​:

Yep.

I think that should do it; the new tests should tell you.

HTH,

--
Rick Delaney
rick@​bort.ca

[p5pRT]

From @nwc10

On Thu, Dec 02, 2004 at 01​:20​:28PM -0500, Rick Delaney wrote​:

On Wed, Dec 01, 2004 at 03​:40​:44PM +0000, Nicholas Clark wrote​:

This patch​:

On Thu, Nov 04, 2004 at 02​:59​:25AM -0800, Rafael Garcia-Suarez wrote​:

These two files should be left alone​:

... //depot/perl/pp.c#427 edit
... //depot/perl/pp_hot.c#361 edit

Look for the ****​:

==== //depot/perl/regexec.c#325 (text) ====

@​@​ -403,6 +403,7 @​@​
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;

**** above should be something like
+ I32 multiline = PL_multiline | (prog->reganch & PMf_MULTILINE);

+ I32 multiline = prog->reganch & PMf_MULTILINE;

**** above should be something like
+ I32 multiline = PL_multiline | (prog->reganch & PMf_MULTILINE);

**** The following changes in this file would not be suitable for maint​:

I presume that the conflicts are due to the removal of $* from blead​:

Yep.

I think that should do it; the new tests should tell you.

Yes, bang on.

Sorry that it's taken so long (and a really big tuit) to make the time to do
this. (It never got started because I feared that it might not be, and I might
get bogged down for ages trying to work it out, delaying whatever other
merging I was trying to get finished)

Nicholas Clark