From: Ilya Zakharevich <ilya@math.berkeley.edu>
Date: Sun, 7 Feb 1999 17:25:22 +0000 (-0500)
Subject: s/\ba/./g was over-optimized
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=f5c9036e8e34a1c3af842cea81cf0efef683a2b8;p=p5sagit%2Fp5-mst-13.2.git

s/\ba/./g was over-optimized

	Message-ID: <19990207172522.B894@monk.mps.ohio-state.edu>

p4raw-id: //depot/perl@2828
---

diff --git a/MANIFEST b/MANIFEST
index 8e114a2..b336861 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -1186,6 +1186,8 @@ t/op/sprintf.t		See if sprintf works
 t/op/stat.t		See if stat works
 t/op/study.t		See if study works
 t/op/subst.t		See if substitution works
+t/op/subst_amp.t	See if $&-related substitution works
+t/op/subst_wamp.t	See if substitution works with $& present
 t/op/substr.t		See if substr works
 t/op/sysio.t		See if sysread and syswrite work
 t/op/taint.t		See if tainting works
diff --git a/regcomp.c b/regcomp.c
index 91f9d7b..61c3e0d 100644
--- a/regcomp.c
+++ b/regcomp.c
@@ -1777,6 +1777,7 @@ tryagain:
 	    break;
 	case 'b':
 	    PL_seen_zerolen++;
+	    PL_regseen |= REG_SEEN_LOOKBEHIND;
 	    ret = reg_node(
 		UTF
 		    ? (LOC ? BOUNDLUTF8 : BOUNDUTF8)
@@ -1788,6 +1789,7 @@ tryagain:
 	    break;
 	case 'B':
 	    PL_seen_zerolen++;
+	    PL_regseen |= REG_SEEN_LOOKBEHIND;
 	    ret = reg_node(
 		UTF
 		    ? (LOC ? NBOUNDLUTF8 : NBOUNDUTF8)
diff --git a/t/op/subst.t b/t/op/subst.t
index 6776a1e..bfca868 100755
--- a/t/op/subst.t
+++ b/t/op/subst.t
@@ -6,7 +6,7 @@ BEGIN {
     require Config; import Config;
 }
 
-print "1..93\n";
+print "1..82\n";
 
 $x = 'foo';
 $_ = "x";
@@ -312,7 +312,7 @@ s{  \d+          \b [,.;]? (?{ 'digits' })
 print ($_ eq $foo ? "ok 70\n" : "not ok 70\n#'$_'\n#'$foo'\n");
 
 $_ = 'x' x 20; 
-s/\d*|x/<$&>/g; 
+s/(\d*|x)/<$1>/g; 
 $foo = '<>' . ('<x><>' x 20) ;
 print ($_ eq $foo ? "ok 71\n" : "not ok 71\n#'$_'\n#'$foo'\n");
 
@@ -362,98 +362,14 @@ s/\Ga/x/;
 print "not " unless $_ eq 'xaaaaaaaa';
 print "ok 79\n";
 
-$t = 'aaa';
-
-$_ = $t;
-@res = ();
-pos = 1;
-s/\Ga(?{push @res, $_, $`})/xx/g;
-print "not " unless "$_ @res" eq 'axxxx aaa a aaa aa';
+$_ = 'aaaa';
+s/\ba/./g;
+print "#'$_'\nnot " unless $_ eq '.aaa';
 print "ok 80\n";
 
-$_ = $t;
-@res = ();
-pos = 1;
-s/\Ga(?{push @res, $_, $`})/x/g;
-print "not " unless "$_ @res" eq 'axx aaa a aaa aa';
-print "ok 81\n";
-
-$_ = $t;
-@res = ();
-pos = 1;
-s/\Ga(?{push @res, $_, $`})/xx/;
-print "not " unless "$_ @res" eq 'axxa aaa a';
-print "ok 82\n";
-
-$_ = $t;
-@res = ();
-pos = 1;
-s/\Ga(?{push @res, $_, $`})/x/;
-print "not " unless "$_ @res" eq 'axa aaa a';
-print "ok 83\n";
-
-$a = $t;
-@res = ();
-pos ($a) = 1;
-$a =~ s/\Ga(?{push @res, $_, $`})/xx/g;
-print "#'$a' '@res'\nnot " unless "$a @res" eq 'axxxx aaa a aaa aa';
-print "ok 84\n";
-
-$a = $t;
-@res = ();
-pos ($a) = 1;
-$a =~ s/\Ga(?{push @res, $_, $`})/x/g;
-print "#'$a' '@res'\nnot " unless "$a @res" eq 'axx aaa a aaa aa';
-print "ok 85\n";
-
-$a = $t;
-@res = ();
-pos ($a) = 1;
-$a =~ s/\Ga(?{push @res, $_, $`})/xx/;
-print "#'$a' '@res'\nnot " unless "$a @res" eq 'axxa aaa a';
-print "ok 86\n";
-
-$a = $t;
-@res = ();
-pos ($a) = 1;
-$a =~ s/\Ga(?{push @res, $_, $`})/x/;
-print "#'$a' '@res'\nnot " unless "$a @res" eq 'axa aaa a';
-print "ok 87\n";
-
-sub x2 {'xx'}
-sub x1 {'x'}
-
-$a = $t;
-@res = ();
-pos ($a) = 1;
-$a =~ s/\Ga(?{push @res, $_, $`})/x2/ge;
-print "#'$a' '@res'\nnot " unless "$a @res" eq 'axxxx aaa a aaa aa';
-print "ok 88\n";
-
-$a = $t;
-@res = ();
-pos ($a) = 1;
-$a =~ s/\Ga(?{push @res, $_, $`})/x1/ge;
-print "#'$a' '@res'\nnot " unless "$a @res" eq 'axx aaa a aaa aa';
-print "ok 89\n";
-
-$a = $t;
-@res = ();
-pos ($a) = 1;
-$a =~ s/\Ga(?{push @res, $_, $`})/x2/e;
-print "#'$a' '@res'\nnot " unless "$a @res" eq 'axxa aaa a';
-print "ok 90\n";
-
-$a = $t;
-@res = ();
-pos ($a) = 1;
-$a =~ s/\Ga(?{push @res, $_, $`})/x1/e;
-print "#'$a' '@res'\nnot " unless "$a @res" eq 'axa aaa a';
-print "ok 91\n";
-
 eval q% s/a/"b"}/e %;
-print ($@ =~ /Bad evalled substitution/ ? "ok 92\n" : "not ok 92\n");
+print ($@ =~ /Bad evalled substitution/ ? "ok 81\n" : "not ok 81\n");
 eval q% ($_ = "x") =~ s/(.)/"$1 "/e %;
-print +($_ eq "x " and !length $@) ? "ok 93\n" : "not ok 93\n# \$_ eq $_, $@\n";
+print +($_ eq "x " and !length $@) ? "ok 82\n" : "not ok 82\n# \$_ eq $_, $@\n";
 
 
diff --git a/t/op/subst_amp.t b/t/op/subst_amp.t
new file mode 100755
index 0000000..e5e31f5
--- /dev/null
+++ b/t/op/subst_amp.t
@@ -0,0 +1,104 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib' if -d '../lib';
+    require Config; import Config;
+}
+
+print "1..13\n";
+
+$_ = 'x' x 20; 
+s/\d*|x/<$&>/g; 
+$foo = '<>' . ('<x><>' x 20) ;
+print ($_ eq $foo ? "ok 1\n" : "not ok 1\n#'$_'\n#'$foo'\n");
+
+$t = 'aaa';
+
+$_ = $t;
+@res = ();
+pos = 1;
+s/\Ga(?{push @res, $_, $`})/xx/g;
+print "not " unless "$_ @res" eq 'axxxx aaa a aaa aa';
+print "ok 2\n";
+
+$_ = $t;
+@res = ();
+pos = 1;
+s/\Ga(?{push @res, $_, $`})/x/g;
+print "not " unless "$_ @res" eq 'axx aaa a aaa aa';
+print "ok 3\n";
+
+$_ = $t;
+@res = ();
+pos = 1;
+s/\Ga(?{push @res, $_, $`})/xx/;
+print "not " unless "$_ @res" eq 'axxa aaa a';
+print "ok 4\n";
+
+$_ = $t;
+@res = ();
+pos = 1;
+s/\Ga(?{push @res, $_, $`})/x/;
+print "not " unless "$_ @res" eq 'axa aaa a';
+print "ok 5\n";
+
+$a = $t;
+@res = ();
+pos ($a) = 1;
+$a =~ s/\Ga(?{push @res, $_, $`})/xx/g;
+print "#'$a' '@res'\nnot " unless "$a @res" eq 'axxxx aaa a aaa aa';
+print "ok 6\n";
+
+$a = $t;
+@res = ();
+pos ($a) = 1;
+$a =~ s/\Ga(?{push @res, $_, $`})/x/g;
+print "#'$a' '@res'\nnot " unless "$a @res" eq 'axx aaa a aaa aa';
+print "ok 7\n";
+
+$a = $t;
+@res = ();
+pos ($a) = 1;
+$a =~ s/\Ga(?{push @res, $_, $`})/xx/;
+print "#'$a' '@res'\nnot " unless "$a @res" eq 'axxa aaa a';
+print "ok 8\n";
+
+$a = $t;
+@res = ();
+pos ($a) = 1;
+$a =~ s/\Ga(?{push @res, $_, $`})/x/;
+print "#'$a' '@res'\nnot " unless "$a @res" eq 'axa aaa a';
+print "ok 9\n";
+
+sub x2 {'xx'}
+sub x1 {'x'}
+
+$a = $t;
+@res = ();
+pos ($a) = 1;
+$a =~ s/\Ga(?{push @res, $_, $`})/x2/ge;
+print "#'$a' '@res'\nnot " unless "$a @res" eq 'axxxx aaa a aaa aa';
+print "ok 10\n";
+
+$a = $t;
+@res = ();
+pos ($a) = 1;
+$a =~ s/\Ga(?{push @res, $_, $`})/x1/ge;
+print "#'$a' '@res'\nnot " unless "$a @res" eq 'axx aaa a aaa aa';
+print "ok 11\n";
+
+$a = $t;
+@res = ();
+pos ($a) = 1;
+$a =~ s/\Ga(?{push @res, $_, $`})/x2/e;
+print "#'$a' '@res'\nnot " unless "$a @res" eq 'axxa aaa a';
+print "ok 12\n";
+
+$a = $t;
+@res = ();
+pos ($a) = 1;
+$a =~ s/\Ga(?{push @res, $_, $`})/x1/e;
+print "#'$a' '@res'\nnot " unless "$a @res" eq 'axa aaa a';
+print "ok 13\n";
+
diff --git a/t/op/subst_wamp.t b/t/op/subst_wamp.t
new file mode 100755
index 0000000..b716b30
--- /dev/null
+++ b/t/op/subst_wamp.t
@@ -0,0 +1,11 @@
+#!./perl
+
+$dummy = defined $&;		# Now we have it...
+for $file ('op/subst.t', 't/op/subst.t') {
+  if (-r $file) {
+    do $file;
+    exit;
+  }
+}
+die "Cannot find op/subst.t or t/op/subst.t\n";
+