This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Remove commented out reference to Test::More
[perl5.git] / regexec.c
index 5d31d73..41b91ca 100644 (file)
--- a/regexec.c
+++ b/regexec.c
@@ -1821,24 +1821,38 @@ Perl_regexec_flags(pTHX_ REGEXP * const rx, char *stringarg, register char *stre
 
     if (prog->extflags & RXf_GPOS_SEEN) { /* Need to set reginfo->ganch */
        MAGIC *mg;
-
-       if (flags & REXEC_IGNOREPOS)    /* Means: check only at start */
+       if (flags & REXEC_IGNOREPOS){   /* Means: check only at start */
            reginfo.ganch = startpos + prog->gofs;
-       else if (sv && SvTYPE(sv) >= SVt_PVMG
+           DEBUG_GPOS_r(PerlIO_printf(Perl_debug_log,
+             "GPOS IGNOREPOS: reginfo.ganch = startpos + %"UVxf"\n",(UV)prog->gofs));
+       } else if (sv && SvTYPE(sv) >= SVt_PVMG
                  && SvMAGIC(sv)
                  && (mg = mg_find(sv, PERL_MAGIC_regex_global))
                  && mg->mg_len >= 0) {
            reginfo.ganch = strbeg + mg->mg_len;        /* Defined pos() */
+           DEBUG_GPOS_r(PerlIO_printf(Perl_debug_log,
+               "GPOS MAGIC: reginfo.ganch = strbeg + %"IVdf"\n",(IV)mg->mg_len));
+
            if (prog->extflags & RXf_ANCH_GPOS) {
                if (s > reginfo.ganch)
                    goto phooey;
                s = reginfo.ganch - prog->gofs;
+               DEBUG_GPOS_r(PerlIO_printf(Perl_debug_log,
+                    "GPOS ANCH_GPOS: s = ganch - %"UVxf"\n",(UV)prog->gofs));
+               if (s < strbeg)
+                   goto phooey;
            }
        }
        else if (data) {
            reginfo.ganch = strbeg + PTR2UV(data);
-       } else                          /* pos() not defined */
+            DEBUG_GPOS_r(PerlIO_printf(Perl_debug_log,
+                "GPOS DATA: reginfo.ganch= strbeg + %"UVxf"\n",PTR2UV(data)));
+
+       } else {                                /* pos() not defined */
            reginfo.ganch = strbeg;
+            DEBUG_GPOS_r(PerlIO_printf(Perl_debug_log,
+                "GPOS: reginfo.ganch = strbeg\n"));
+       }
     }
     if (PL_curpm && (PM_GETRE(PL_curpm) == rx)) {
         /* We have to be careful. If the previous successful match
@@ -1915,7 +1929,8 @@ Perl_regexec_flags(pTHX_ REGEXP * const rx, char *stringarg, register char *stre
            is bogus -- we set it above, when prog->extflags & RXf_GPOS_SEEN 
            and we only enter this block when the same bit is set. */
         char *tmp_s = reginfo.ganch - prog->gofs;
-       if (regtry(&reginfo, &tmp_s))
+
+       if (tmp_s >= strbeg && regtry(&reginfo, &tmp_s))
            goto got_it;
        goto phooey;
     }
@@ -3329,6 +3344,47 @@ S_regmatch(pTHX_ regmatch_info *reginfo, regnode *prog)
            nextchr = UCHARAT(locinput);
            break;
            }
+       case BOUNDL:
+       case NBOUNDL:
+           PL_reg_flags |= RF_tainted;
+           /* FALL THROUGH */
+       case BOUND:
+       case NBOUND:
+           /* was last char in word? */
+           if (do_utf8) {
+               if (locinput == PL_bostr)
+                   ln = '\n';
+               else {
+                   const U8 * const r = reghop3((U8*)locinput, -1, (U8*)PL_bostr);
+
+                   ln = utf8n_to_uvchr(r, UTF8SKIP(r), 0, uniflags);
+               }
+               if (OP(scan) == BOUND || OP(scan) == NBOUND) {
+                   ln = isALNUM_uni(ln);
+                   LOAD_UTF8_CHARCLASS_ALNUM();
+                   n = swash_fetch(PL_utf8_alnum, (U8*)locinput, do_utf8);
+               }
+               else {
+                   ln = isALNUM_LC_uvchr(UNI_TO_NATIVE(ln));
+                   n = isALNUM_LC_utf8((U8*)locinput);
+               }
+           }
+           else {
+               ln = (locinput != PL_bostr) ?
+                   UCHARAT(locinput - 1) : '\n';
+               if (OP(scan) == BOUND || OP(scan) == NBOUND) {
+                   ln = isALNUM(ln);
+                   n = isALNUM(nextchr);
+               }
+               else {
+                   ln = isALNUM_LC(ln);
+                   n = isALNUM_LC(nextchr);
+               }
+           }
+           if (((!ln) == (!n)) == (OP(scan) == BOUND ||
+                                   OP(scan) == BOUNDL))
+                   sayNO;
+           break;
        case ANYOF:
            if (do_utf8) {
                STRLEN inclasslen = PL_regeol - locinput;
@@ -3408,47 +3464,6 @@ S_regmatch(pTHX_ regmatch_info *reginfo, regnode *prog)
                sayNO;
            nextchr = UCHARAT(++locinput);
            break;
-       case BOUNDL:
-       case NBOUNDL:
-           PL_reg_flags |= RF_tainted;
-           /* FALL THROUGH */
-       case BOUND:
-       case NBOUND:
-           /* was last char in word? */
-           if (do_utf8) {
-               if (locinput == PL_bostr)
-                   ln = '\n';
-               else {
-                   const U8 * const r = reghop3((U8*)locinput, -1, (U8*)PL_bostr);
-               
-                   ln = utf8n_to_uvchr(r, UTF8SKIP(r), 0, uniflags);
-               }
-               if (OP(scan) == BOUND || OP(scan) == NBOUND) {
-                   ln = isALNUM_uni(ln);
-                   LOAD_UTF8_CHARCLASS_ALNUM();
-                   n = swash_fetch(PL_utf8_alnum, (U8*)locinput, do_utf8);
-               }
-               else {
-                   ln = isALNUM_LC_uvchr(UNI_TO_NATIVE(ln));
-                   n = isALNUM_LC_utf8((U8*)locinput);
-               }
-           }
-           else {
-               ln = (locinput != PL_bostr) ?
-                   UCHARAT(locinput - 1) : '\n';
-               if (OP(scan) == BOUND || OP(scan) == NBOUND) {
-                   ln = isALNUM(ln);
-                   n = isALNUM(nextchr);
-               }
-               else {
-                   ln = isALNUM_LC(ln);
-                   n = isALNUM_LC(nextchr);
-               }
-           }
-           if (((!ln) == (!n)) == (OP(scan) == BOUND ||
-                                   OP(scan) == BOUNDL))
-                   sayNO;
-           break;
        case SPACEL:
            PL_reg_flags |= RF_tainted;
            /* FALL THROUGH */
@@ -3468,17 +3483,11 @@ S_regmatch(pTHX_ regmatch_info *reginfo, regnode *prog)
                    nextchr = UCHARAT(locinput);
                    break;
                }
-               if (!(OP(scan) == SPACE
-                     ? isSPACE(nextchr) : isSPACE_LC(nextchr)))
-                   sayNO;
-               nextchr = UCHARAT(++locinput);
-           }
-           else {
-               if (!(OP(scan) == SPACE
-                     ? isSPACE(nextchr) : isSPACE_LC(nextchr)))
-                   sayNO;
-               nextchr = UCHARAT(++locinput);
            }
+           if (!(OP(scan) == SPACE
+                 ? isSPACE(nextchr) : isSPACE_LC(nextchr)))
+               sayNO;
+           nextchr = UCHARAT(++locinput);
            break;
        case NSPACEL:
            PL_reg_flags |= RF_tainted;