Zero-length matching bug
Ilya Zakharevich [Sun, 21 Jun 1998 04:27:16 +0000 (00:27 -0400)]
Message-Id: <199806210827.EAA26322@monk.mps.ohio-state.edu>

p4raw-id: //depot/perl@1185

regexec.c
t/op/pat.t

index b6d2ca4..dd51bc1 100644 (file)
--- a/regexec.c
+++ b/regexec.c
@@ -697,7 +697,7 @@ regtry(regexp *prog, char *startpos)
        }
     }
     REGCP_SET;
-    if (regmatch(prog->program + 1) && reginput >= regtill) {
+    if (regmatch(prog->program + 1)) {
        prog->startp[0] = startpos;
        prog->endp[0] = reginput;
        return 1;
@@ -1504,8 +1504,11 @@ regmatch(regnode *prog)
            }
            sayNO;
            break;
-       case SUCCEED:
        case END:
+           if (locinput < regtill)
+               sayNO;                  /* Cannot match: too short. */
+           /* Fall through */
+       case SUCCEED:
            reginput = locinput;        /* put where regtry can find it */
            sayYES;                     /* Success! */
        case SUSPEND:
index 9377b99..f0bbdbc 100755 (executable)
@@ -2,7 +2,7 @@
 
 # $RCSfile: pat.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:12 $
 
-print "1..108\n";
+print "1..113\n";
 
 $x = "abc\ndef\n";
 
@@ -378,6 +378,22 @@ print "not " unless study(/\b\v$/) eq '\bv$';
 print "ok $test\n";
 $test++;
 
+$_ = 'xabcx';
+foreach $ans ('', 'c') {
+  /(?<=(?=a)..)((?=c)|.)/g;
+  print "not " unless $1 eq $ans;
+  print "ok $test\n";
+  $test++;
+}
+
+$_ = 'a';
+foreach $ans ('', 'a', '') {
+  /^|a|$/g;
+  print "not " unless $& eq $ans;
+  print "ok $test\n";
+  $test++;
+}
+
 sub must_warn_pat {
     my $warn_pat = shift;
     return sub { print "not " unless $_[0] =~ /$warn_pat/ }