This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Re: [perl #28532] optional match of an anchor gets ignored
authorHugo van der Sanden <hv@crypt.org>
Wed, 14 Apr 2004 19:30:46 +0000 (20:30 +0100)
committerRafael Garcia-Suarez <rgarciasuarez@gmail.com>
Mon, 19 Apr 2004 08:30:20 +0000 (08:30 +0000)
Message-Id: <200404141830.i3EIUko03728@zen.crypt.org>

p4raw-id: //depot/perl@22712

regcomp.c
regexec.c
t/op/pat.t

index 6293ade..68fe68c 100644 (file)
--- a/regcomp.c
+++ b/regcomp.c
@@ -1188,7 +1188,9 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap, reg
                if (  OP(oscan) == CURLYX && data
                      && !(data->flags & SF_HAS_PAR)
                      && !(data->flags & SF_HAS_EVAL)
-                     && !deltanext  ) {
+                     && !deltanext     /* atom is fixed width */
+                     && minnext != 0   /* CURLYM can't handle zero width */
+               ) {
                    /* XXXX How to optimize if data == 0? */
                    /* Optimize to a simpler form.  */
                    regnode *nxt = NEXTOPER(oscan) + EXTRA_STEP_2ARGS; /* OPEN */
index 63cb5e9..728b1ae 100644 (file)
--- a/regexec.c
+++ b/regexec.c
@@ -3367,7 +3367,7 @@ S_regmatch(pTHX_ regnode *prog)
            CHECKPOINT lastcp;
        
            /* We suppose that the next guy does not need
-              backtracking: in particular, it is of constant length,
+              backtracking: in particular, it is of constant non-zero length,
               and has no parenths to influence future backrefs. */
            ln = ARG1(scan);  /* min to match */
            n  = ARG2(scan);  /* max to match */
@@ -3386,15 +3386,6 @@ S_regmatch(pTHX_ regnode *prog)
                minmod = 0;
                if (ln && regrepeat_hard(scan, ln, &l) < ln)
                    sayNO;
-               /* if we matched something zero-length we don't need to
-                  backtrack - capturing parens are already defined, so
-                  the caveat in the maximal case doesn't apply
-
-                  XXXX if ln == 0, we can redo this check first time
-                  through the following loop
-               */
-               if (ln && l == 0)
-                   n = ln;     /* don't backtrack */
                locinput = PL_reginput;
                if (HAS_TEXT(next) || JUMPABLE(next)) {
                    regnode *text_node = next;
@@ -3420,8 +3411,7 @@ S_regmatch(pTHX_ regnode *prog)
                    c1 = c2 = -1000;
            assume_ok_MM:
                REGCP_SET(lastcp);
-               /* This may be improved if l == 0.  */
-               while (n >= ln || (n == REG_INFTY && ln > 0 && l)) { /* ln overflow ? */
+               while (n >= ln || (n == REG_INFTY && ln > 0)) { /* ln overflow ? */
                    /* If it could work, try it. */
                    if (c1 == -1000 ||
                        UCHARAT(PL_reginput) == c1 ||
@@ -3452,13 +3442,6 @@ S_regmatch(pTHX_ regnode *prog)
            }
            else {
                n = regrepeat_hard(scan, n, &l);
-               /* if we matched something zero-length we don't need to
-                  backtrack, unless the minimum count is zero and we
-                  are capturing the result - in that case the capture
-                  being defined or not may affect later execution
-               */
-               if (n != 0 && l == 0 && !(paren && ln == 0))
-                   ln = n;     /* don't backtrack */
                locinput = PL_reginput;
                DEBUG_r(
                    PerlIO_printf(Perl_debug_log,
@@ -4263,7 +4246,7 @@ S_regrepeat(pTHX_ regnode *p, I32 max)
 /*
  - regrepeat_hard - repeatedly match something, report total lenth and length
  *
- * The repeater is supposed to have constant length.
+ * The repeater is supposed to have constant non-zero length.
  */
 
 STATIC I32
index 9907149..de48188 100755 (executable)
@@ -6,7 +6,7 @@
 
 $| = 1;
 
-print "1..1063\n";
+print "1..1065\n";
 
 BEGIN {
     chdir 't' if -d 't';
@@ -3278,4 +3278,10 @@ ok("a\cBb" =~ /[\cA-\cC]/, '\cB in character class range');
 ok("a\cCbc" =~ /[^\cA-\cB]/, '\cC in negated character class range');
 ok("a\cAb" =~ /(??{"\cA"})/, '\cA in ??{} pattern');
 
-# last test 1063
+# perl #28532: optional zero-width match at end of string is ignored
+ok(("abc" =~ /^abc(\z)?/) && defined($1),
+    'optional zero-width match at end of string');
+ok(("abc" =~ /^abc(\z)??/) && !defined($1),
+    'optional zero-width match at end of string');
+
+# last test 1065