From: Ilya Zakharevich <ilya@math.berkeley.edu>
Date: Mon, 18 Jan 1999 20:57:02 +0000 (-0500)
Subject: Fixing \G bug by Francois Desarmenien
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=b7a3506667c18cfc70741a0ddfa0a7815e72775a;p=p5sagit%2Fp5-mst-13.2.git

Fixing \G bug by Francois Desarmenien

To: Mailing list Perl5 <perl5-porters@perl.org>
Message-ID: <19990118205702.A18379@monk.mps.ohio-state.edu>

p4raw-id: //depot/cfgperl@2644
---

diff --git a/pp_hot.c b/pp_hot.c
index b538427..622621f 100644
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -881,7 +881,8 @@ PP(pp_match)
 	if (SvTYPE(TARG) >= SVt_PVMG && SvMAGIC(TARG)) {
 	    MAGIC* mg = mg_find(TARG, 'g');
 	    if (mg && mg->mg_len >= 0) {
-		rx->endp[0] = rx->startp[0] = s + mg->mg_len; 
+		if (!(rx->reganch & ROPT_GPOS_SEEN))
+		    rx->endp[0] = rx->startp[0] = s + mg->mg_len; 
 		minmatch = (mg->mg_flags & MGf_MINMATCH);
 		update_minmatch = 0;
 	    }
diff --git a/t/op/pat.t b/t/op/pat.t
index abb10fd..63219a3 100755
--- a/t/op/pat.t
+++ b/t/op/pat.t
@@ -4,7 +4,7 @@
 # the format supported by op/regexp.t.  If you want to add a test
 # that does fit that format, add it to op/re_tests, not here.
 
-print "1..178\n";
+print "1..184\n";
 
 BEGIN {
     chdir 't' if -d 't';
@@ -803,6 +803,46 @@ print "#'@res' '$_'\nnot "
 print "ok $test\n";
 $test++;
 
+#Some more \G anchor checks
+$foo='aabbccddeeffgg';
+
+pos($foo)=1;
+
+$foo=~/.\G(..)/g;
+print "not " unless($1 eq 'ab');
+print "ok $test\n";
+$test++;
+
+pos($foo) += 1;
+$foo=~/.\G(..)/g;
+print "not " unless($1 eq 'cc');
+print "ok $test\n";
+$test++;
+
+pos($foo) += 1;
+$foo=~/.\G(..)/g;
+print "not " unless($1 eq 'de');
+print "ok $test\n";
+$test++;
+
+undef pos $foo;
+
+$foo=~/\G(..)/g;
+print "not " unless($1  eq 'aa');
+print "ok $test\n";
+$test++;
+
+$foo=~/\G(..)/g;
+print "not " unless($1  eq 'bb');
+print "ok $test\n";
+$test++;
+
+pos($foo)=5;
+$foo=~/\G(..)/g;
+print "not " unless($1  eq 'cd');
+print "ok $test\n";
+$test++;
+
 # see if matching against temporaries (created via pp_helem()) is safe
 { foo => "ok $test\n".$^X }->{foo} =~ /^(.*)\n/g;
 print "$1\n";