Re: Strange RE engine breakage in 5_61

To: François Désarménien <desar@club-internet.fr>
Cc: "perl5-porters@perl.org" <perl5-porters@perl.org>
Message-ID: <19991004195803.A21760@monk.mps.ohio-state.edu>

(had to apply pat.t part manually because there
 already were more tests than there was in _61)

p4raw-id: //depot/cfgperl@4301

diff --git a/regcomp.c b/regcomp.c
index 921472a..99423e1 100644 (file)
--- a/regcomp.c
+++ b/regcomp.c
@@ -1076,7 +1076,9 @@ Perl_pregcomp(pTHX_ char *exp, char *xend, PMOP *pm)
            r->check_offset_min = data.offset_float_min;
            r->check_offset_max = data.offset_float_max;
        }
-       if (r->check_substr) {
+       /* XXXX Currently intuiting is not compatible with ANCH_GPOS.
+          This should be changed ASAP!  */
+       if (r->check_substr && !(r->reganch & ROPT_ANCH_GPOS)) {
            r->reganch |= RE_USE_INTUIT;
            if (SvTAIL(r->check_substr))
                r->reganch |= RE_INTUIT_TAIL;

diff --git a/regexec.c b/regexec.c
index a567353..048ae49 100644 (file)
--- a/regexec.c
+++ b/regexec.c
@@ -739,19 +739,23 @@ Perl_regexec_flags(pTHX_ register regexp *prog, char *stringarg, register char *
     /* If there is a "must appear" string, look for it. */
     s = startpos;
 
-    if (prog->reganch & ROPT_GPOS_SEEN) {
+    if (prog->reganch & ROPT_GPOS_SEEN) { /* Need to have PL_reg_ganch */
        MAGIC *mg;
 
-       if (!(flags & REXEC_IGNOREPOS) && sv && SvTYPE(sv) >= SVt_PVMG
-           && SvMAGIC(sv) && (mg = mg_find(sv, 'g')) && mg->mg_len >= 0)
-           PL_reg_ganch = strbeg + mg->mg_len;
-       else
+       if (flags & REXEC_IGNOREPOS)    /* Means: check only at start */
            PL_reg_ganch = startpos;
-       if (prog->reganch & ROPT_ANCH_GPOS) {
-           if (s > PL_reg_ganch)
-               goto phooey;
-           s = PL_reg_ganch;
+       else if (sv && SvTYPE(sv) >= SVt_PVMG
+                 && SvMAGIC(sv)
+                 && (mg = mg_find(sv, 'g')) && mg->mg_len >= 0) {
+           PL_reg_ganch = strbeg + mg->mg_len; /* Defined pos() */
+           if (prog->reganch & ROPT_ANCH_GPOS) {
+               if (s > PL_reg_ganch)
+                   goto phooey;
+               s = PL_reg_ganch;
+           }
        }
+       else                            /* pos() not defined */
+           PL_reg_ganch = strbeg;
     }
 
     if (!(flags & REXEC_CHECKED) && prog->check_substr != Nullsv) {

diff --git a/t/op/pat.t b/t/op/pat.t
index 89cc2bb..f36394e 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..192\n";
+print "1..193\n";
 
 BEGIN {
     chdir 't' if -d 't';
@@ -887,3 +887,9 @@ pos=1;
 m/^-.*bb/mg and print "not ";
 print "ok $test\n";
 $test++;
+
+$text = "aaXbXcc";
+pos($text)=0;
+$text =~ /\GXb*X/g and print 'not ';
+print "ok $test\n";
+$test++;

diff --git a/t/op/re_tests b/t/op/re_tests
index b35e964..695672d 100644 (file)
--- a/t/op/re_tests
+++ b/t/op/re_tests
@@ -739,3 +739,4 @@ tt+$        xxxtt   y       -       -
 [\w-z] -       c       -       /[\w-z]/: invalid [] range in regexp
 [0-[:digit:]]  -       c       -       /[0-[:digit:]]/: invalid [] range in regexp
 [[:digit:]-9]  -       c       -       /[[:digit:]-9]/: invalid [] range in regexp
+\GX.*X aaaXbX  n       -       -