Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

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

Closed
p5pRT opened this issue Apr 5, 2000 · 11 comments
Closed

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

p5pRT opened this issue Apr 5, 2000 · 11 comments

Comments

@p5pRT
Copy link

@p5pRT p5pRT commented Apr 5, 2000

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

Searchable as RT3038$

@p5pRT
Copy link
Author

@p5pRT p5pRT commented Apr 5, 2000

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
Copy link
Author

@p5pRT p5pRT commented Apr 5, 2000

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
Copy link
Author

@p5pRT p5pRT commented Nov 1, 2004

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
Copy link
Author

@p5pRT p5pRT commented Nov 3, 2004

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
Copy link
Author

@p5pRT p5pRT commented Nov 4, 2004

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 p5pRT closed this Nov 4, 2004
@p5pRT
Copy link
Author

@p5pRT p5pRT commented Nov 4, 2004

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

@p5pRT
Copy link
Author

@p5pRT p5pRT commented Dec 1, 2004

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&#8203;: \[PATCH blead\] \[perl \#3038\] Re&#8203;: $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
Copy link
Author

@p5pRT p5pRT commented Dec 2, 2004

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&#8203;: \[PATCH blead\] \[perl \#3038\] Re&#8203;: $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
Copy link
Author

@p5pRT p5pRT commented Mar 25, 2006

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

@cuj
Copy link

@cuj cuj commented Aug 27, 2021

but why is this created in 2000-2006 I thought github released in 2008

@nwc10
Copy link
Contributor

@nwc10 nwc10 commented Aug 27, 2021

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).

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Projects
None yet
Linked pull requests

Successfully merging a pull request may close this issue.

None yet
3 participants