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 363e205..41b91ca 100644 (file)
--- a/regexec.c
+++ b/regexec.c
@@ -1007,15 +1007,16 @@ Perl_re_intuit_start(pTHX_ REGEXP * const rx, SV *sv, char *strpos,
 
 #define REXEC_TRIE_READ_CHAR(trie_type, trie, widecharmap, uc, uscan, len,  \
 uvc, charid, foldlen, foldbuf, uniflags) STMT_START {                       \
+    UV uvc_unfolded = 0;                                                   \
     switch (trie_type) {                                                    \
     case trie_utf8_fold:                                                    \
        if ( foldlen>0 ) {                                                  \
-           uvc = utf8n_to_uvuni( uscan, UTF8_MAXLEN, &len, uniflags );     \
+           uvc_unfolded = uvc = utf8n_to_uvuni( uscan, UTF8_MAXLEN, &len, uniflags ); \
            foldlen -= len;                                                 \
            uscan += len;                                                   \
            len=0;                                                          \
        } else {                                                            \
-           uvc = utf8n_to_uvuni( (U8*)uc, UTF8_MAXLEN, &len, uniflags );   \
+           uvc_unfolded = uvc = utf8n_to_uvuni( (U8*)uc, UTF8_MAXLEN, &len, uniflags ); \
            uvc = to_uni_fold( uvc, foldbuf, &foldlen );                    \
            foldlen -= UNISKIP( uvc );                                      \
            uscan = foldbuf + UNISKIP( uvc );                               \
@@ -1054,6 +1055,9 @@ uvc, charid, foldlen, foldbuf, uniflags) STMT_START {                       \
                charid = (U16)SvIV(*svpp);                                  \
        }                                                                   \
     }                                                                       \
+    if (!charid && trie_type == trie_utf8_fold && !UTF) {                  \
+       charid = trie->charmap[uvc_unfolded];                               \
+    }                                                                      \
 } STMT_END
 
 #define REXEC_FBC_EXACTISH_CHECK(CoNd)                 \
@@ -1730,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
@@ -1781,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;
@@ -1839,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;
@@ -1926,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;
     }
@@ -2160,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)
@@ -2205,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;
 }
 
@@ -2250,7 +2257,7 @@ S_regtry(pTHX_ regmatch_info *reginfo, char **startpos)
            /* Make $_ available to executed code. */
            if (reginfo->sv != DEFSV) {
                SAVE_DEFSV;
-               DEFSV = reginfo->sv;
+               DEFSV_set(reginfo->sv);
            }
        
            if (!(SvTYPE(reginfo->sv) >= SVt_PVMG && SvMAGIC(reginfo->sv)
@@ -2590,7 +2597,7 @@ S_debug_start_match(pTHX_ const REGEXP *prog, const bool do_utf8,
             reginitcolors();    
     {
         RE_PV_QUOTED_DECL(s0, utf8_pat, PERL_DEBUG_PAD_ZERO(0), 
-            RX_PRECOMP(prog), RX_PRELEN(prog), 60);   
+            RX_PRECOMP_const(prog), RX_PRELEN(prog), 60);   
         
         RE_PV_QUOTED_DECL(s1, do_utf8, PERL_DEBUG_PAD_ZERO(1), 
             start, end - start, 60); 
@@ -2837,6 +2844,11 @@ S_regmatch(pTHX_ regmatch_info *reginfo, regnode *prog)
        state_num = OP(scan);
 
       reenter_switch:
+
+       assert(PL_reglastparen == &rex->lastparen);
+       assert(PL_reglastcloseparen == &rex->lastcloseparen);
+       assert(PL_regoffs == rex->offs);
+
        switch (state_num) {
        case BOL:
            if (locinput == PL_bostr)
@@ -3003,7 +3015,7 @@ S_regmatch(pTHX_ regmatch_info *reginfo, regnode *prog)
                    if ( got_wordnum ) {
                        if ( ! ST.accepted ) {
                            ENTER;
-                           /* SAVETMPS; */ /* XXX is this necessary? dmq */
+                           SAVETMPS; /* XXX is this necessary? dmq */
                            bufflen = TRIE_INITAL_ACCEPT_BUFFLEN;
                            sv_accept_buff=newSV(bufflen *
                                            sizeof(reg_trie_accepted) - 1);
@@ -3222,6 +3234,9 @@ S_regmatch(pTHX_ regmatch_info *reginfo, regnode *prog)
            }
            /* NOTREACHED */
         case TRIE_next:
+           /* we dont want to throw this away, see bug 57042*/
+           if (oreplsv != GvSV(PL_replgv))
+               sv_setsv(oreplsv, GvSV(PL_replgv));
             FREETMPS;
            LEAVE;
            sayYES;
@@ -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;
@@ -3704,6 +3713,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];
@@ -3729,6 +3739,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);
@@ -3882,9 +3893,12 @@ S_regmatch(pTHX_ regmatch_info *reginfo, regnode *prog)
            regcpblow(ST.cp);
            cur_eval = ST.prev_eval;
            cur_curlyx = ST.prev_curlyx;
-           
+
+           /* rex was changed so update the pointer in PL_reglastparen and PL_reglastcloseparen */
            PL_reglastparen = &rex->lastparen;
            PL_reglastcloseparen = &rex->lastcloseparen;
+           /* also update PL_regoffs */
+           PL_regoffs = rex->offs;
            
            /* XXXX This is too dramatic a measure... */
            PL_reg_maxiter = 0;
@@ -3900,6 +3914,7 @@ S_regmatch(pTHX_ regmatch_info *reginfo, regnode *prog)
            SETREX(rex_sv,ST.prev_rex);
            rex = (struct regexp *)SvANY(rex_sv);
            rexi = RXi_GET(rex); 
+           /* rex was changed so update the pointer in PL_reglastparen and PL_reglastcloseparen */
            PL_reglastparen = &rex->lastparen;
            PL_reglastcloseparen = &rex->lastcloseparen;
 
@@ -4395,7 +4410,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
             */
@@ -4462,8 +4477,11 @@ NULL
                cur_eval->u.eval.close_paren == (U32)ST.me->flags) 
                goto fake_end;
                
-           if ( ST.count < (ST.minmod ? ARG1(ST.me) : ARG2(ST.me)) )
-               goto curlym_do_A; /* try to match another A */
+           {
+               I32 max = (ST.minmod ? ARG1(ST.me) : ARG2(ST.me));
+               if ( max == REG_INFTY || ST.count < max )
+                   goto curlym_do_A; /* try to match another A */
+           }
            goto curlym_do_B; /* try to match B */
 
        case CURLYM_A_fail: /* just failed to match an A */
@@ -4555,7 +4573,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 */
            }
@@ -4902,6 +4921,11 @@ NULL
                cur_curlyx = cur_eval->u.eval.prev_curlyx;
                ReREFCNT_inc(rex_sv);
                st->u.eval.cp = regcppush(0);   /* Save *all* the positions. */
+
+               /* rex was changed so update the pointer in PL_reglastparen and PL_reglastcloseparen */
+               PL_reglastparen = &rex->lastparen;
+               PL_reglastcloseparen = &rex->lastcloseparen;
+
                REGCP_SET(st->u.eval.lastcp);
                PL_reginput = locinput;
 
@@ -5768,7 +5792,14 @@ S_reginclass(pTHX_ const regexp *prog, register const regnode *n, register const
            SV * const sw = regclass_swash(prog, n, TRUE, 0, (SV**)&av);
        
            if (sw) {
-               if (swash_fetch(sw, p, do_utf8))
+               U8 * utf8_p;
+               if (do_utf8) {
+                   utf8_p = (U8 *) p;
+               } else {
+                   STRLEN len = 1;
+                   utf8_p = bytes_to_utf8(p, &len);
+               }
+               if (swash_fetch(sw, utf8_p, 1))
                    match = TRUE;
                else if (flags & ANYOF_FOLD) {
                    if (!match && lenp && av) {
@@ -5777,8 +5808,7 @@ S_reginclass(pTHX_ const regexp *prog, register const regnode *n, register const
                            SV* const sv = *av_fetch(av, i, FALSE);
                            STRLEN len;
                            const char * const s = SvPV_const(sv, len);
-                       
-                           if (len <= plen && memEQ(s, (char*)p, len)) {
+                           if (len <= plen && memEQ(s, (char*)utf8_p, len)) {
                                *lenp = len;
                                match = TRUE;
                                break;
@@ -5787,13 +5817,16 @@ S_reginclass(pTHX_ const regexp *prog, register const regnode *n, register const
                    }
                    if (!match) {
                        U8 tmpbuf[UTF8_MAXBYTES_CASE+1];
-                       STRLEN tmplen;
 
-                       to_utf8_fold(p, tmpbuf, &tmplen);
-                       if (swash_fetch(sw, tmpbuf, do_utf8))
+                       STRLEN tmplen;
+                       to_utf8_fold(utf8_p, tmpbuf, &tmplen);
+                       if (swash_fetch(sw, tmpbuf, 1))
                            match = TRUE;
                    }
                }
+
+               /* If we allocated a string above, free it */
+               if (! do_utf8) Safefree(utf8_p);
            }
        }
        if (match && lenp && *lenp == 0)