This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
fix format warnings from regexec.c
[perl5.git] / regexec.c
index 93fadab..221e360 100644 (file)
--- a/regexec.c
+++ b/regexec.c
@@ -1734,28 +1734,6 @@ S_find_byclass(pTHX_ regexp * prog, const regnode *c, char *s,
        return s;
 }
 
-static void 
-S_swap_match_buff (pTHX_ regexp *prog)
-{
-    regexp_paren_pair *t;
-
-    PERL_ARGS_ASSERT_SWAP_MATCH_BUFF;
-
-    if (!prog->swap) {
-    /* We have to be careful. If the previous successful match
-       was from this regex we don't want a subsequent paritally
-       successful match to clobber the old results. 
-       So when we detect this possibility we add a swap buffer
-       to the re, and switch the buffer each match. If we fail
-       we switch it back, otherwise we leave it swapped.
-    */
-        Newxz(prog->swap, (prog->nparens + 1), regexp_paren_pair);
-    }
-    t = prog->swap;
-    prog->swap = prog->offs;
-    prog->offs = t;
-}    
-
 
 /*
  - regexec_flags - match a regexp against a string
@@ -1785,7 +1763,7 @@ Perl_regexec_flags(pTHX_ REGEXP * const rx, char *stringarg, register char *stre
     I32 multiline;
     RXi_GET_DECL(prog,progi);
     regmatch_info reginfo;  /* create some info to pass to regtry etc */
-    bool swap_on_fail = 0;
+    regexp_paren_pair *swap = NULL;
     GET_RE_DEBUG_FLAGS_DECL;
 
     PERL_ARGS_ASSERT_REGEXEC_FLAGS;
@@ -1843,29 +1821,50 @@ 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)) {
-        swap_on_fail = 1;
-        swap_match_buff(prog); /* do we need a save destructor here for
-                                  eval dies? */
+        /* We have to be careful. If the previous successful match
+           was from this regex we don't want a subsequent partially
+           successful match to clobber the old results.
+           So when we detect this possibility we add a swap buffer
+           to the re, and switch the buffer each match. If we fail
+           we switch it back, otherwise we leave it swapped.
+        */
+        swap = prog->offs;
+        /* do we need a save destructor here for eval dies? */
+        Newxz(prog->offs, (prog->nparens + 1), regexp_paren_pair);
     }
     if (!(flags & REXEC_CHECKED) && (prog->check_substr != NULL || prog->check_utf8 != NULL)) {
        re_scream_pos_data d;
@@ -1930,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;
     }
@@ -2164,6 +2164,7 @@ Perl_regexec_flags(pTHX_ REGEXP * const rx, char *stringarg, register char *stre
     goto phooey;
 
 got_it:
+    Safefree(swap);
     RX_MATCH_TAINTED_set(rx, PL_reg_flags & RF_tainted);
 
     if (PL_reg_eval_set)
@@ -2209,10 +2210,12 @@ phooey:
                          PL_colors[4], PL_colors[5]));
     if (PL_reg_eval_set)
        restore_pos(aTHX_ prog);
-    if (swap_on_fail) 
+    if (swap) {
         /* we failed :-( roll it back */
-        swap_match_buff(prog);
-    
+        Safefree(prog->offs);
+        prog->offs = swap;
+    }
+
     return 0;
 }
 
@@ -3716,6 +3719,7 @@ S_regmatch(pTHX_ regmatch_info *reginfo, regnode *prog)
                OP_4tree * const oop = PL_op;
                COP * const ocurcop = PL_curcop;
                PAD *old_comppad;
+               char *saved_regeol = PL_regeol;
            
                n = ARG(scan);
                PL_op = (OP_4tree*)rexi->data->data[n];
@@ -3741,6 +3745,7 @@ S_regmatch(pTHX_ regmatch_info *reginfo, regnode *prog)
                PL_op = oop;
                PAD_RESTORE_LOCAL(old_comppad);
                PL_curcop = ocurcop;
+               PL_regeol = saved_regeol;
                if (!logical) {
                    /* /(?{...})/ */
                    sv_setsv(save_scalar(PL_replgv), ret);
@@ -4411,7 +4416,7 @@ NULL
        case CURLYM:    /* /A{m,n}B/ where A is fixed-length */
 
            /* This is an optimisation of CURLYX that enables us to push
-            * only a single backtracking state, no matter now many matches
+            * only a single backtracking state, no matter how many matches
             * there are in {m,n}. It relies on the pattern being constant
             * length, with no parens to influence future backrefs
             */
@@ -4574,7 +4579,8 @@ NULL
        case CURLYM_B_fail: /* just failed to match a B */
            REGCP_UNWIND(ST.cp);
            if (ST.minmod) {
-               if (ST.count == ARG2(ST.me) /* max */)
+               I32 max = ARG2(ST.me);
+               if (max != REG_INFTY && ST.count == max)
                    sayNO;
                goto curlym_do_A; /* try to match a further A */
            }