Add new tests for keys in %+ and %-
[p5sagit/p5-mst-13.2.git] / regexec.c
index 72b9e87..1ae9842 100644 (file)
--- a/regexec.c
+++ b/regexec.c
 /* TODO: Combine JUMPABLE and HAS_TEXT to cache OP(rn) */
 
 /* for use after a quantifier and before an EXACT-like node -- japhy */
-#define JUMPABLE(rn) ( \
-    OP(rn) == OPEN || OP(rn) == CLOSE || OP(rn) == EVAL || \
+/* it would be nice to rework regcomp.sym to generate this stuff. sigh */
+#define JUMPABLE(rn) (      \
+    OP(rn) == OPEN ||       \
+    (OP(rn) == CLOSE && (!cur_eval || cur_eval->u.eval.close_paren != ARG(rn))) || \
+    OP(rn) == EVAL ||   \
     OP(rn) == SUSPEND || OP(rn) == IFMATCH || \
     OP(rn) == PLUS || OP(rn) == MINMOD || \
     OP(rn) == KEEPS || (PL_regkind[OP(rn)] == VERB) || \
@@ -1646,7 +1649,7 @@ S_find_byclass(pTHX_ regexp * prog, const regnode *c, char *s,
        return s;
 }
 
-void 
+static void 
 S_swap_match_buff (pTHX_ regexp *prog) {
     I32 *t;
     RXi_GET_DECL(prog,progi);
@@ -2139,8 +2142,6 @@ phooey:
 }
 
 
-
-
 /*
  - regtry - try match at specific point
  */
@@ -2639,7 +2640,11 @@ S_regmatch(pTHX_ regmatch_info *reginfo, regnode *prog)
 
     bool result = 0;       /* return value of S_regmatch */
     int depth = 0;         /* depth of backtrack stack */
-    int nochange_depth = 0; /* depth of GOSUB recursion with nochange*/
+    U32 nochange_depth = 0; /* depth of GOSUB recursion with nochange */
+    const U32 max_nochange_depth =
+        (3 * rex->nparens > MAX_RECURSE_EVAL_NOCHANGE_DEPTH) ?
+        3 * rex->nparens : MAX_RECURSE_EVAL_NOCHANGE_DEPTH;
+            
     regmatch_state *yes_state = NULL; /* state to pop to on success of
                                                            subpattern */
     /* mark_state piggy backs on the yes_state logic so that when we unwind 
@@ -2679,9 +2684,9 @@ S_regmatch(pTHX_ regmatch_info *reginfo, regnode *prog)
     GET_RE_DEBUG_FLAGS_DECL;
 #endif
 
-    DEBUG_OPTIMISE_r( {    
+    DEBUG_OPTIMISE_r( DEBUG_EXECUTE_r({
            PerlIO_printf(Perl_debug_log,"regmatch start\n");
-    });
+    }));
     /* on first ever call to regmatch, allocate first slab */
     if (!PL_regmatch_slab) {
        Newx(PL_regmatch_slab, 1, regmatch_slab);
@@ -3567,7 +3572,7 @@ S_regmatch(pTHX_ regmatch_info *reginfo, regnode *prog)
             if (cur_eval && cur_eval->locinput==locinput) {
                 if (cur_eval->u.eval.close_paren == (U32)ARG(scan)) 
                     Perl_croak(aTHX_ "Infinite recursion in regex");
-                if ( ++nochange_depth > MAX_RECURSE_EVAL_NOCHANGE_DEPTH ) 
+                if ( ++nochange_depth > max_nochange_depth )
                     Perl_croak(aTHX_ 
                         "Pattern subroutine nesting without pos change"
                         " exceeded limit in regex");
@@ -3588,14 +3593,11 @@ S_regmatch(pTHX_ regmatch_info *reginfo, regnode *prog)
             /* NOTREACHED */
         case EVAL:  /*   /(?{A})B/   /(??{A})B/  and /(?(?{A})X|Y)B/   */        
             if (cur_eval && cur_eval->locinput==locinput) {
-                if ( ++nochange_depth > MAX_RECURSE_EVAL_NOCHANGE_DEPTH ) 
+               if ( ++nochange_depth > max_nochange_depth )
                     Perl_croak(aTHX_ "EVAL without pos change exceeded limit in regex");
             } else {
                 nochange_depth = 0;
             }    
-            {   regexp *ocurpm = PM_GETRE(PL_curpm);
-               char *osubbeg = rex->subbeg;
-               STRLEN osublen = rex->sublen;
            {
                /* execute the code in the {...} */
                dSP;
@@ -3603,7 +3605,6 @@ S_regmatch(pTHX_ regmatch_info *reginfo, regnode *prog)
                OP_4tree * const oop = PL_op;
                COP * const ocurcop = PL_curcop;
                PAD *old_comppad;
-
            
                n = ARG(scan);
                PL_op = (OP_4tree*)rexi->data->data[n];
@@ -3616,10 +3617,6 @@ S_regmatch(pTHX_ regmatch_info *reginfo, regnode *prog)
                     SV *sv_mrk = get_sv("REGMARK", 1);
                     sv_setsv(sv_mrk, sv_yes_mark);
                 }
-                /* make sure that $1 and friends are available with nested eval */
-                PM_SETRE(PL_curpm,rex);
-                rex->subbeg = ocurpm->subbeg;
-                rex->sublen = ocurpm->sublen;
 
                CALLRUNOPS(aTHX);                       /* Scalar context. */
                SPAGAIN;
@@ -3633,7 +3630,6 @@ S_regmatch(pTHX_ regmatch_info *reginfo, regnode *prog)
                PL_op = oop;
                PAD_RESTORE_LOCAL(old_comppad);
                PL_curcop = ocurcop;
-
                if (!logical) {
                    /* /(?{...})/ */
                    sv_setsv(save_scalar(PL_replgv), ret);
@@ -3679,12 +3675,6 @@ S_regmatch(pTHX_ regmatch_info *reginfo, regnode *prog)
                    }
                }
                rei = RXi_GET(re);
-
-                /* restore PL_curpm after the eval */
-                PM_SETRE(PL_curpm,ocurpm);
-                rex->sublen = osublen;
-                rex->subbeg = osubbeg;
-
                 DEBUG_EXECUTE_r(
                     debug_start_match(re, do_utf8, locinput, PL_regeol, 
                         "Matching embedded");
@@ -3698,8 +3688,7 @@ S_regmatch(pTHX_ regmatch_info *reginfo, regnode *prog)
                         Renew(PL_reg_start_tmp, PL_reg_start_tmpl, char*);
                     else
                         Newx(PL_reg_start_tmp, PL_reg_start_tmpl, char*);
-                }
-
+                }                      
 
         eval_recurse_doit: /* Share code with GOSUB below this line */                         
                /* run the pattern returned from (??{...}) */
@@ -3736,11 +3725,6 @@ S_regmatch(pTHX_ regmatch_info *reginfo, regnode *prog)
                PUSH_YES_STATE_GOTO(EVAL_AB, startpoint);
                /* NOTREACHED */
            }
-           /* restore PL_curpm after the eval */
-           PM_SETRE(PL_curpm,ocurpm);
-            rex->sublen = osublen;
-            rex->subbeg = osubbeg;
-           }
            /* logical is 1,   /(?(?{...})X|Y)/ */
            sw = (bool)SvTRUE(ret);
            logical = 0;
@@ -3758,6 +3742,8 @@ S_regmatch(pTHX_ regmatch_info *reginfo, regnode *prog)
            cur_curlyx = ST.prev_curlyx;
            /* XXXX This is too dramatic a measure... */
            PL_reg_maxiter = 0;
+            if ( nochange_depth > 0 );
+               nochange_depth--;
            sayYES;
 
 
@@ -3774,6 +3760,8 @@ S_regmatch(pTHX_ regmatch_info *reginfo, regnode *prog)
            cur_curlyx = ST.prev_curlyx;
            /* XXXX This is too dramatic a measure... */
            PL_reg_maxiter = 0;
+           if ( nochange_depth > 0 );
+               nochange_depth--;
            sayNO_SILENT;
 #undef ST
 
@@ -4394,6 +4382,12 @@ NULL
                    && UCHARAT(PL_reginput) != ST.c2)
            {
                /* simulate B failing */
+               DEBUG_OPTIMISE_r(
+                   PerlIO_printf(Perl_debug_log,
+                       "%*s  CURLYM Fast bail c1=%"IVdf" c2=%"IVdf"\n",
+                       (int)(REPORT_CODE_OFF+(depth*2)),"",
+                       (IV)ST.c1,(IV)ST.c2
+               ));
                state_num = CURLYM_B_fail;
                goto reenter_switch;
            }
@@ -4788,6 +4782,8 @@ NULL
                DEBUG_EXECUTE_r(
                    PerlIO_printf(Perl_debug_log, "%*s  EVAL trying tail ... %"UVxf"\n",
                                      REPORT_CODE_OFF+depth*2, "",PTR2UV(cur_eval)););
+                if ( nochange_depth > 0 );
+                   nochange_depth++;
                PUSH_YES_STATE_GOTO(EVAL_AB,
                        st->u.eval.prev_eval->u.eval.B); /* match B */
            }
@@ -5183,6 +5179,9 @@ S_regrepeat(pTHX_ const regexp *prog, const regnode *p, I32 max, int depth)
     register char *loceol = PL_regeol;
     register I32 hardcount = 0;
     register bool do_utf8 = PL_reg_match_utf8;
+#ifndef DEBUGGING
+    PERL_UNUSED_ARG(depth);
+#endif
 
     scan = PL_reginput;
     if (max == REG_INFTY)