NetBSD update, based on patches from the NetBSD packages system.

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

diff --git a/regexec.c b/regexec.c
index e4de1ed..c410627 100644 (file)
--- a/regexec.c
+++ b/regexec.c
@@ -264,10 +264,12 @@ cache_re(regexp *prog)
 
 STATIC void
 restore_pos(void *arg)
-{      
+{
+    dTHR;
     if (PL_reg_eval_set) {    
        PL_reg_magic->mg_len = PL_reg_oldpos;
        PL_reg_eval_set = 0;
+       PL_curpm = PL_reg_oldcurpm;
     }  
 }
 
@@ -401,10 +403,8 @@ regexec_flags(register regexp *prog, char *stringarg, register char *strend,
            s = startpos;
     }
 
-    DEBUG_r(
-       if (!PL_colorset)
-           reginitcolors();    
-       PerlIO_printf(Perl_debug_log, 
+    DEBUG_r(if (!PL_colorset) reginitcolors());
+    DEBUG_r(PerlIO_printf(Perl_debug_log, 
                      "%sMatching%s `%s%.60s%s%s' against `%s%.*s%s%s'\n",
                      PL_colors[4],PL_colors[5],PL_colors[0],
                      prog->precomp,
@@ -418,12 +418,12 @@ regexec_flags(register regexp *prog, char *stringarg, register char *strend,
 
     if (prog->reganch & ROPT_GPOS_SEEN) {
        MAGIC *mg;
-       int pos = 0;
 
-       if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv) 
-           && (mg = mg_find(sv, 'g')) && mg->mg_len >= 0)
-           pos = mg->mg_len;
-       PL_reg_ganch = startpos + pos;
+       if (!(flags & REXEC_IGNOREPOS) && sv && SvTYPE(sv) >= SVt_PVMG
+           && SvMAGIC(sv) && (mg = mg_find(sv, 'g')) && mg->mg_len >= 0)
+           PL_reg_ganch = strbeg + mg->mg_len;
+       else
+           PL_reg_ganch = startpos;
     }
 
     /* Simplest case:  anchored match need be tried only once. */
@@ -1011,14 +1011,15 @@ got_it:
            }
        }
     }
-    /* Preserve the current value of $^R */
-    if (oreplsv != GvSV(PL_replgv)) {
-       sv_setsv(oreplsv, GvSV(PL_replgv));/* So that when GvSV(replgv) is
-                                          restored, the value remains
-                                          the same. */
-    }
-    if (PL_reg_eval_set)
+    if (PL_reg_eval_set) {
+       /* Preserve the current value of $^R */
+       if (oreplsv != GvSV(PL_replgv))
+           sv_setsv(oreplsv, GvSV(PL_replgv));/* So that when GvSV(replgv) is
+                                                 restored, the value remains
+                                                 the same. */
        restore_pos(0);
+    }
+    
     return 1;
 
 phooey:
@@ -1057,9 +1058,10 @@ regtry(regexp *prog, char *startpos)
 
        if (PL_reg_sv) {
            /* Make $_ available to executed code. */
-           if (PL_reg_sv != GvSV(PL_defgv)) {
-               SAVESPTR(GvSV(PL_defgv));
-               GvSV(PL_defgv) = PL_reg_sv;
+           if (PL_reg_sv != DEFSV) {
+               /* SAVE_DEFSV does *not* suffice here for USE_THREADS */
+               SAVESPTR(DEFSV);
+               DEFSV = PL_reg_sv;
            }
        
            if (!(SvTYPE(PL_reg_sv) >= SVt_PVMG && SvMAGIC(PL_reg_sv) 
@@ -1073,13 +1075,22 @@ regtry(regexp *prog, char *startpos)
            PL_reg_oldpos   = mg->mg_len;
            SAVEDESTRUCTOR(restore_pos, 0);
         }
+       if (!PL_reg_curpm)
+           New(22,PL_reg_curpm, 1, PMOP);
+       PL_reg_curpm->op_pmregexp = prog;
+       PL_reg_oldcurpm = PL_curpm;
+       PL_curpm = PL_reg_curpm;
+       prog->subbeg = PL_bostr;
+       prog->subend = PL_regeol;       /* strend may have been modified */
     }
+    prog->startp[0] = startpos;
     PL_reginput = startpos;
     PL_regstartp = prog->startp;
     PL_regendp = prog->endp;
     PL_reglastparen = &prog->lastparen;
     prog->lastparen = 0;
     PL_regsize = 0;
+    DEBUG_r(PL_reg_starttry = startpos);
     if (PL_reg_start_tmpl <= prog->nparens) {
        PL_reg_start_tmpl = prog->nparens*3/2 + 3;
         if(PL_reg_start_tmp)
@@ -1088,17 +1099,19 @@ regtry(regexp *prog, char *startpos)
             New(22,PL_reg_start_tmp, PL_reg_start_tmpl, char*);
     }
 
+    /* XXXX What this code is doing here?!!!  There should be no need
+       to do this again and again, PL_reglastparen should take care of
+       this!  */
     sp = prog->startp;
     ep = prog->endp;
     if (prog->nparens) {
-       for (i = prog->nparens; i >= 0; i--) {
-           *sp++ = NULL;
-           *ep++ = NULL;
+       for (i = prog->nparens; i >= 1; i--) {
+           *++sp = NULL;
+           *++ep = NULL;
        }
     }
     REGCP_SET;
     if (regmatch(prog->program + 1)) {
-       prog->startp[0] = startpos;
        prog->endp[0] = PL_reginput;
        return 1;
     }
@@ -1161,7 +1174,7 @@ regmatch(regnode *prog)
            int l = (PL_regeol - locinput > taill ? taill : PL_regeol - locinput);
            int pref_len = (locinput - PL_bostr > (5 + taill) - l 
                            ? (5 + taill) - l : locinput - PL_bostr);
-           int pref0_len = pref_len  - (locinput - PL_reginput);
+           int pref0_len = pref_len  - (locinput - PL_reg_starttry);
 
            if (l + pref_len < (5 + taill) && l < PL_regeol - locinput)
                l = ( PL_regeol - locinput > (5 + taill) - pref_len 
@@ -1645,6 +1658,7 @@ regmatch(regnode *prog)
            DEBUG_r( PerlIO_printf(Perl_debug_log, "  re_eval 0x%x\n", PL_op) );
            PL_curpad = AvARRAY((AV*)PL_regdata->data[n + 1]);
            PL_reg_magic->mg_len = locinput - PL_bostr;
+           PL_regendp[0] = locinput;
 
            CALLRUNOPS();                       /* Scalar context. */
            SPAGAIN;
@@ -2655,7 +2669,7 @@ regrepeat_hard(regnode *p, I32 max, I32 *lp)
 }
 
 /*
- - regclass - determine if a character falls into a character class
+ - reginclass - determine if a character falls into a character class
  */
 
 STATIC bool