Patch by Abigail to avoid using $& in diagnostics.pm.

[p5sagit/p5-mst-13.2.git] / regexec.c

diff --git a/regexec.c b/regexec.c
index 8c3365a..dc0cd9b 100644 (file)
--- a/regexec.c
+++ b/regexec.c
@@ -193,7 +193,7 @@ S_regcppush(pTHX_ I32 parenfloor)
        SSPUSHINT(PL_regstartp[p]);
        SSPUSHPTR(PL_reg_start_tmp[p]);
        SSPUSHINT(p);
-       DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
+       DEBUG_BUFFERS_r(PerlIO_printf(Perl_debug_log,
          "     saving \\%"UVuf" %"IVdf"(%"IVdf")..%"IVdf"\n",
                      (UV)p, (IV)PL_regstartp[p],
                      (IV)(PL_reg_start_tmp[p] - PL_bostr),
@@ -263,7 +263,7 @@ S_regcppop(pTHX_ const regexp *rex)
        tmps = SSPOPINT;
        if (paren <= *PL_reglastparen)
            PL_regendp[paren] = tmps;
-       DEBUG_EXECUTE_r(
+       DEBUG_BUFFERS_r(
            PerlIO_printf(Perl_debug_log,
                          "     restoring \\%"UVuf" to %"IVdf"(%"IVdf")..%"IVdf"%s\n",
                          (UV)paren, (IV)PL_regstartp[paren],
@@ -272,7 +272,7 @@ S_regcppop(pTHX_ const regexp *rex)
                          (paren > *PL_reglastparen ? "(no)" : ""));
        );
     }
-    DEBUG_EXECUTE_r(
+    DEBUG_BUFFERS_r(
        if (*PL_reglastparen + 1 <= rex->nparens) {
            PerlIO_printf(Perl_debug_log,
                          "     restoring \\%"IVdf"..\\%"IVdf" to undef\n",
@@ -2314,7 +2314,7 @@ S_regtry(pTHX_ regmatch_info *reginfo, char **startpos)
 STATIC regmatch_state *
 S_push_slab(pTHX)
 {
-#if PERL_VERSION < 9
+#if PERL_VERSION < 9 && !defined(PERL_CORE)
     dMY_CXT;
 #endif
     regmatch_slab *s = PL_regmatch_slab->next;
@@ -2485,7 +2485,7 @@ regmatch(), slabs allocated since entry are freed.
        PerlIO_printf(Perl_debug_log,                       \
            "    %*s"pp" %s%s%s%s%s\n",                     \
            depth*2, "",                                    \
-           reg_name[st->resume_state],                     \
+           PL_reg_name[st->resume_state],                     \
            ((st==yes_state||st==mark_state) ? "[" : ""),   \
            ((st==yes_state) ? "Y" : ""),                   \
            ((st==mark_state) ? "M" : ""),                  \
@@ -2614,7 +2614,7 @@ S_reg_check_named_buff_matched(pTHX_ const regexp *rex, const regnode *scan) {
 STATIC I32                     /* 0 failure, 1 success */
 S_regmatch(pTHX_ regmatch_info *reginfo, regnode *prog)
 {
-#if PERL_VERSION < 9
+#if PERL_VERSION < 9 && !defined(PERL_CORE)
     dMY_CXT;
 #endif
     dVAR;
@@ -2640,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 
@@ -2680,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);
@@ -3564,11 +3568,11 @@ S_regmatch(pTHX_ regmatch_info *reginfo, regnode *prog)
             regnode *startpoint;
 
        case GOSTART:
-       case GOSUB: /*    /(...(?1))/      */
-            if (cur_eval && cur_eval->locinput==locinput) {
+       case GOSUB: /*    /(...(?1))/   /(...(?&foo))/   */
+           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");
@@ -3589,7 +3593,7 @@ 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;
@@ -3738,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 )
+               nochange_depth--;
            sayYES;
 
 
@@ -3754,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 )
+               nochange_depth--;
            sayNO_SILENT;
 #undef ST
 
@@ -4747,8 +4755,6 @@ NULL
            if (cur_eval) {
                /* we've just finished A in /(??{A})B/; now continue with B */
                I32 tmpix;
-
-
                st->u.eval.toggle_reg_flags
                            = cur_eval->u.eval.toggle_reg_flags;
                PL_reg_flags ^= st->u.eval.toggle_reg_flags; 
@@ -4774,7 +4780,10 @@ NULL
                DEBUG_EXECUTE_r(
                    PerlIO_printf(Perl_debug_log, "%*s  EVAL trying tail ... %"UVxf"\n",
                                      REPORT_CODE_OFF+depth*2, "",PTR2UV(cur_eval)););
-               PUSH_YES_STATE_GOTO(EVAL_AB,
+                if ( nochange_depth )
+                   nochange_depth--;
+
+                PUSH_YES_STATE_GOTO(EVAL_AB,
                        st->u.eval.prev_eval->u.eval.B); /* match B */
            }
 
@@ -4999,7 +5008,7 @@ NULL
                     }
                     PerlIO_printf(Perl_error_log, "%*s#%-3d %-10s %s\n",
                         REPORT_CODE_OFF + 2 + depth * 2,"",
-                        curd, reg_name[cur->resume_state],
+                        curd, PL_reg_name[cur->resume_state],
                         (curyes == cur) ? "yes" : ""
                     );
                     if (curyes == cur)
@@ -5169,6 +5178,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)