Fix list-context //g with zero-length matches

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

p4raw-id: //depot/cfgperl@2840

diff --git a/pp_hot.c b/pp_hot.c
index 622621f..98763b8 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -844,6 +844,7 @@ PP(pp_match)
     I32 minmatch = 0;
     I32 oldsave = PL_savestack_ix;
     I32 update_minmatch = 1;
+    I32 had_zerolen = 0;
 
     if (PL_op->op_flags & OPf_STACKED)
        TARG = POPs;
@@ -907,7 +908,7 @@ play_it_again:
        if ((s + rx->minlen) > strend)
            goto nope;
        if (update_minmatch++)
-           minmatch = (s == rx->startp[0]);
+           minmatch = had_zerolen;
     }
     if (rx->check_substr) {
        if (!(rx->reganch & ROPT_NOSCAN)) { /* Floating checkstring. */
@@ -993,8 +994,7 @@ play_it_again:
        if (global) {
            truebase = rx->subbeg;
            strend = rx->subend;
-           if (rx->startp[0] && rx->startp[0] == rx->endp[0])
-               ++rx->endp[0];
+           had_zerolen = (rx->startp[0] && rx->startp[0] == rx->endp[0]);
            PUTBACK;                    /* EVAL blocks may use stack */
            r_flags |= REXEC_IGNOREPOS;
            goto play_it_again;

diff --git a/t/op/pat.t b/t/op/pat.t
index 63219a3..b56f7b4 100755 (executable)
--- 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..184\n";
+print "1..185\n";
 
 BEGIN {
     chdir 't' if -d 't';
@@ -843,6 +843,12 @@ print "not " unless($1  eq 'cd');
 print "ok $test\n";
 $test++;
 
+$_='123x123'; 
+@res = /(\d*|x)/g;
+print "not " unless('123||x|123|' eq join '|', @res);
+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";