This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Make t/op/regexp.t warnings clean.
[perl5.git] / regexec.c
index 9286bba..6c82ba7 100644 (file)
--- a/regexec.c
+++ b/regexec.c
@@ -56,7 +56,7 @@
  ****    Alterations to Henry's code are...
  ****
  ****    Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
- ****    2000, 2001, 2002, 2003, 2004, 2005, 2006, by Larry Wall and others
+ ****    2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007 by Larry Wall and others
  ****
  ****    You may distribute under the terms of either the GNU General Public
  ****    License or the Artistic License, as specified in the README file.
     OP(rn) == OPEN || OP(rn) == CLOSE || OP(rn) == EVAL || \
     OP(rn) == SUSPEND || OP(rn) == IFMATCH || \
     OP(rn) == PLUS || OP(rn) == MINMOD || \
+    OP(rn) == KEEPS || (PL_regkind[OP(rn)] == VERB) || \
     (PL_regkind[OP(rn)] == CURLY && ARG1(rn) > 0) \
 )
+#define IS_EXACT(rn) (PL_regkind[OP(rn)] == EXACT)
 
-#define HAS_TEXT(rn) ( \
-    PL_regkind[OP(rn)] == EXACT || PL_regkind[OP(rn)] == REF \
-)
+#define HAS_TEXT(rn) ( IS_EXACT(rn) || PL_regkind[OP(rn)] == REF )
+
+#if 0 
+/* Currently these are only used when PL_regkind[OP(rn)] == EXACT so
+   we don't need this definition. */
+#define IS_TEXT(rn)   ( OP(rn)==EXACT   || OP(rn)==REF   || OP(rn)==NREF   )
+#define IS_TEXTF(rn)  ( OP(rn)==EXACTF  || OP(rn)==REFF  || OP(rn)==NREFF  )
+#define IS_TEXTFL(rn) ( OP(rn)==EXACTFL || OP(rn)==REFFL || OP(rn)==NREFFL )
+
+#else
+/* ... so we use this as its faster. */
+#define IS_TEXT(rn)   ( OP(rn)==EXACT   )
+#define IS_TEXTF(rn)  ( OP(rn)==EXACTF  )
+#define IS_TEXTFL(rn) ( OP(rn)==EXACTFL )
+
+#endif
 
 /*
   Search for mandatory following text node; for lookahead, the text must
@@ -483,7 +498,7 @@ Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos,
        /* end shift should be non negative here */
     }
 
-#ifdef DEBUGGING       /* 7/99: reports of failure (with the older version) */
+#ifdef QDEBUGGING      /* 7/99: reports of failure (with the older version) */
     if (end_shift < 0)
        Perl_croak(aTHX_ "panic: end_shift: %"IVdf" pattern:\n%s\n ",
                   (IV)end_shift, prog->precomp);
@@ -514,7 +529,7 @@ Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos,
 
        if (PL_screamfirst[BmRARE(check)] >= 0
            || ( BmRARE(check) == '\n'
-                && (BmPREVIOUS(check) == (U8)SvCUR(check) - 1)
+                && (BmPREVIOUS(check) == SvCUR(check) - 1)
                 && SvTAIL(check) ))
            s = screaminstr(sv, check,
                            srch_start_shift + (s - strbeg), srch_end_shift, pp, 0);
@@ -2119,6 +2134,8 @@ phooey:
 }
 
 
+
+
 /*
  - regtry - try match at specific point
  */
@@ -2726,6 +2743,19 @@ S_regmatch(pTHX_ regmatch_info *reginfo, regnode *prog)
            if (locinput == reginfo->ganch)
                break;
            sayNO;
+
+       case KEEPS:
+           /* update the startpoint */
+           st->u.keeper.val = PL_regstartp[0];
+           PL_reginput = locinput;
+           PL_regstartp[0] = locinput - PL_bostr;
+           PUSH_STATE_GOTO(KEEPS_next, next);
+           /*NOT-REACHED*/
+       case KEEPS_next_fail:
+           /* rollback the start point change */
+           PL_regstartp[0] = st->u.keeper.val;
+           sayNO_SILENT;
+           /*NOT-REACHED*/
        case EOL:
                goto seol;
        case MEOL:
@@ -3546,6 +3576,9 @@ S_regmatch(pTHX_ regmatch_info *reginfo, regnode *prog)
             } else {
                 nochange_depth = 0;
             }    
+            {   regexp *ocurpm = PM_GETRE(PL_curpm);
+               char *osubbeg = rex->subbeg;
+               STRLEN osublen = rex->sublen;
            {
                /* execute the code in the {...} */
                dSP;
@@ -3553,6 +3586,7 @@ 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];
@@ -3565,6 +3599,10 @@ 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;
@@ -3578,6 +3616,7 @@ 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);
@@ -3623,6 +3662,12 @@ 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");
@@ -3636,7 +3681,8 @@ 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 (??{...}) */
@@ -3673,6 +3719,11 @@ 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;
@@ -4292,14 +4343,23 @@ NULL
                    regnode *text_node = ST.B;
                    if (! HAS_TEXT(text_node))
                        FIND_NEXT_IMPT(text_node);
-                   if (HAS_TEXT(text_node)
-                       && PL_regkind[OP(text_node)] != REF)
+                   /* this used to be 
+                       
+                       (HAS_TEXT(text_node) && PL_regkind[OP(text_node)] == EXACT)
+                       
+                       But the former is redundant in light of the latter.
+                       
+                       if this changes back then the macro for 
+                       IS_TEXT and friends need to change.
+                    */
+                   if (PL_regkind[OP(text_node)] == EXACT)
                    {
+                       
                        ST.c1 = (U8)*STRING(text_node);
                        ST.c2 =
-                           (OP(text_node) == EXACTF || OP(text_node) == REFF)
+                           (IS_TEXTF(text_node))
                            ? PL_fold[ST.c1]
-                           : (OP(text_node) == EXACTFL || OP(text_node) == REFFL)
+                           : (IS_TEXTFL(text_node))
                                ? PL_fold_locale[ST.c1]
                                : ST.c1;
                    }
@@ -4427,22 +4487,28 @@ NULL
                if (! HAS_TEXT(text_node))
                    ST.c1 = ST.c2 = CHRTEST_VOID;
                else {
-                   if (PL_regkind[OP(text_node)] == REF) {
+                   if ( PL_regkind[OP(text_node)] != EXACT ) {
                        ST.c1 = ST.c2 = CHRTEST_VOID;
                        goto assume_ok_easy;
                    }
                    else
                        s = (U8*)STRING(text_node);
-
+                    
+                    /*  Currently we only get here when 
+                        
+                        PL_rekind[OP(text_node)] == EXACT
+                    
+                        if this changes back then the macro for IS_TEXT and 
+                        friends need to change. */
                    if (!UTF) {
                        ST.c2 = ST.c1 = *s;
-                       if (OP(text_node) == EXACTF || OP(text_node) == REFF)
+                       if (IS_TEXTF(text_node))
                            ST.c2 = PL_fold[ST.c1];
-                       else if (OP(text_node) == EXACTFL || OP(text_node) == REFFL)
+                       else if (IS_TEXTFL(text_node))
                            ST.c2 = PL_fold_locale[ST.c1];
                    }
                    else { /* UTF */
-                       if (OP(text_node) == EXACTF || OP(text_node) == REFF) {
+                       if (IS_TEXTF(text_node)) {
                             STRLEN ulen1, ulen2;
                             U8 tmpbuf1[UTF8_MAXBYTES_CASE+1];
                             U8 tmpbuf2[UTF8_MAXBYTES_CASE+1];
@@ -4842,7 +4908,7 @@ NULL
                         PerlIO_printf(Perl_debug_log,
                            "%*s  %ssetting cutpoint to mark:%"SVf"...%s\n",
                            REPORT_CODE_OFF+depth*2, "", 
-                           PL_colors[4], (void*)sv_commit, PL_colors[5]);
+                           PL_colors[4], SVfARG(sv_commit), PL_colors[5]);
                });
             }
             mark_state = ST.prev_mark;