add patch for C<use re 'debug'>

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

diff --git a/pp_ctl.c b/pp_ctl.c
index 9b924bc..464e20d 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -67,7 +67,8 @@ PP(pp_regcmaybe)
     return NORMAL;
 }
 
-PP(pp_regcomp) {
+PP(pp_regcomp)
+{
     djSP;
     register PMOP *pm = (PMOP*)cLOGOP->op_other;
     register char *t;
@@ -76,12 +77,12 @@ PP(pp_regcomp) {
     MAGIC *mg = Null(MAGIC*);
 
     tmpstr = POPs;
-    if(SvROK(tmpstr) || SvRMAGICAL(tmpstr)) {
-       SV *sv = SvROK(tmpstr) ? SvRV(tmpstr) : tmpstr;
+    if (SvROK(tmpstr)) {
+       SV *sv = SvRV(tmpstr);
        if(SvMAGICAL(sv))
            mg = mg_find(sv, 'r');
     }
-    if(mg) {
+    if (mg) {
        regexp *re = (regexp *)mg->mg_obj;
        ReREFCNT_dec(pm->op_pmregexp);
        pm->op_pmregexp = ReREFCNT_inc(re);
@@ -100,11 +101,19 @@ PP(pp_regcomp) {
            }
 
            pm->op_pmflags = pm->op_pmpermflags;        /* reset case sensitivity */
-           pm->op_pmregexp = pregcomp(t, t + len, pm);
-           sv_magic(tmpstr,(SV*)ReREFCNT_inc(pm->op_pmregexp),'r',0,0);
+           pm->op_pmregexp = (*regcompp)(t, t + len, pm);
        }
     }
 
+#ifndef INCOMPLETE_TAINTS
+    if (tainting) {
+       if (tainted)
+           pm->op_pmdynflags |= PMdf_TAINTED;
+       else
+           pm->op_pmdynflags &= ~PMdf_TAINTED;
+    }
+#endif
+
     if (!pm->op_pmregexp->prelen && curpm)
        pm = curpm;
     else if (strEQ("\\s+", pm->op_pmregexp->precomp))
@@ -139,14 +148,13 @@ PP(pp_substcont)
        sv_catsv(dstr, POPs);
 
        /* Are we done */
-       if (cx->sb_once || !regexec_flags(rx, s, cx->sb_strend, orig,
+       if (cx->sb_once || !(*regexecp)(rx, s, cx->sb_strend, orig,
                                     s == m, Nullsv, NULL,
                                     cx->sb_safebase ? 0 : REXEC_COPY_STR))
        {
            SV *targ = cx->sb_targ;
            sv_catpvn(dstr, s, cx->sb_strend - s);
 
-           TAINT_IF(cx->sb_rxtainted || RX_MATCH_TAINTED(rx));
            cx->sb_rxtainted |= RX_MATCH_TAINTED(rx);
 
            (void)SvOOK_off(targ);
@@ -721,7 +729,7 @@ PP(pp_sort)
            SAVEOP();
 
            CATCH_SET(TRUE);
-           PUSHSTACK(SI_SORT);
+           PUSHSTACKi(PERLSI_SORT);
            if (sortstash != stash) {
                firstgv = gv_fetchpv("a", TRUE, SVt_PV);
                secondgv = gv_fetchpv("b", TRUE, SVt_PV);
@@ -744,7 +752,7 @@ PP(pp_sort)
            qsortsv((myorigmark+1), max, FUNC_NAME_TO_PTR(sortcv));
 
            POPBLOCK(cx,curpm);
-           POPSTACK();
+           POPSTACK;
            CATCH_SET(oldcatch);
        }
     }
@@ -816,6 +824,8 @@ PP(pp_flop)
        if (SvNIOKp(left) || !SvPOKp(left) ||
          (looks_like_number(left) && *SvPVX(left) != '0') )
        {
+           if (SvNV(left) < IV_MIN || SvNV(right) >= IV_MAX)
+               croak("Range iterator outside integer range");
            i = SvIV(left);
            max = SvIV(right);
            if (max >= i) {
@@ -833,14 +843,13 @@ PP(pp_flop)
            char *tmps = SvPV(final, len);
 
            sv = sv_mortalcopy(left);
-           while (!SvNIOKp(sv) && SvCUR(sv) <= len &&
-               strNE(SvPVX(sv),tmps) ) {
+           while (!SvNIOKp(sv) && SvCUR(sv) <= len) {
                XPUSHs(sv);
+               if (strEQ(SvPVX(sv),tmps))
+                   break;
                sv = sv_2mortal(newSVsv(sv));
                sv_inc(sv);
            }
-           if (strEQ(SvPVX(sv),tmps))
-               XPUSHs(sv);
        }
     }
     else {
@@ -1076,7 +1085,7 @@ die_where(char *message)
 
        while ((cxix = dopoptoeval(cxstack_ix)) < 0 && curstackinfo->si_prev) {
            dounwind(-1);
-           POPSTACK();
+           POPSTACK;
        }
 
        if (cxix >= 0) {
@@ -1368,8 +1377,23 @@ PP(pp_enteriter)
 
     PUSHBLOCK(cx, CXt_LOOP, SP);
     PUSHLOOP(cx, svp, MARK);
-    if (op->op_flags & OPf_STACKED)
+    if (op->op_flags & OPf_STACKED) {
        cx->blk_loop.iterary = (AV*)SvREFCNT_inc(POPs);
+       if (SvTYPE(cx->blk_loop.iterary) != SVt_PVAV) {
+           dPOPss;
+           if (SvNIOKp(sv) || !SvPOKp(sv) ||
+               (looks_like_number(sv) && *SvPVX(sv) != '0')) {
+                if (SvNV(sv) < IV_MIN ||
+                    SvNV((SV*)cx->blk_loop.iterary) >= IV_MAX)
+                    croak("Range iterator outside integer range");
+                cx->blk_loop.iterix = SvIV(sv);
+                cx->blk_loop.itermax = SvIV((SV*)cx->blk_loop.iterary);
+                sv_setiv(*svp, 0); /* make sure index SV is IV capable */
+           }
+           else
+               cx->blk_loop.iterlval = newSVsv(sv);
+       }
+    }
     else {
        cx->blk_loop.iterary = curstack;
        AvFILLp(curstack) = SP - stack_base;
@@ -1448,7 +1472,7 @@ PP(pp_return)
     PMOP *newpm;
     I32 optype = 0;
 
-    if (curstackinfo->si_type == SI_SORT) {
+    if (curstackinfo->si_type == PERLSI_SORT) {
        if (cxstack_ix == sortcxix || dopoptosub(cxstack_ix) <= sortcxix) {
            if (cxstack_ix > sortcxix)
                dounwind(sortcxix);
@@ -1487,10 +1511,22 @@ PP(pp_return)
 
     TAINT_NOT;
     if (gimme == G_SCALAR) {
-       if (MARK < SP)
-           *++newsp = (popsub2 && SvTEMP(*SP))
-                       ? *SP : sv_mortalcopy(*SP);
-       else
+       if (MARK < SP) {
+           if (popsub2) {
+               if (cxsub.cv && CvDEPTH(cxsub.cv) > 1) {
+                   if (SvTEMP(TOPs)) {
+                       *++newsp = SvREFCNT_inc(*SP);
+                       FREETMPS;
+                       sv_2mortal(*newsp);
+                   } else {
+                       FREETMPS;
+                       *++newsp = sv_mortalcopy(*SP);
+                   }
+               } else
+                   *++newsp = (SvTEMP(*SP)) ? *SP : sv_mortalcopy(*SP);
+           } else
+               *++newsp = sv_mortalcopy(*SP);
+       } else
            *++newsp = &sv_undef;
     }
     else if (gimme == G_ARRAY) {
@@ -1751,6 +1787,20 @@ PP(pp_goto)
                AvREAL_off(av);
                av_clear(av);
            }
+           else if (CvXSUB(cv)) {      /* put GvAV(defgv) back onto stack */
+               AV* av;
+               int i;
+#ifdef USE_THREADS
+               av = (AV*)curpad[0];
+#else
+               av = GvAV(defgv);
+#endif
+               items = AvFILLp(av) + 1;
+               stack_sp++;
+               EXTEND(stack_sp, items); /* @_ could have been extended. */
+               Copy(AvARRAY(av), stack_sp, items, SV*);
+               stack_sp += items;
+           }
            if (cx->cx_type == CXt_SUB &&
                !(CvDEPTH(cx->blk_sub.cv) = cx->blk_sub.olddepth))
                SvREFCNT_dec(cx->blk_sub.cv);
@@ -1773,8 +1823,16 @@ PP(pp_goto)
                    SP = stack_base + items;
                }
                else {
+                   SV **newsp;
+                   I32 gimme;
+
                    stack_sp--;         /* There is no cv arg. */
+                   /* Push a mark for the start of arglist */
+                   PUSHMARK(mark); 
                    (void)(*CvXSUB(cv))(cv _PERL_OBJECT_THIS);
+                   /* Pop the current context like a decent sub should */
+                   POPBLOCK(cx, curpm);
+                   /* Do _not_ use PUTBACK, keep the XSUB's return stack! */
                }
                LEAVE;
                return pop_return();
@@ -2176,7 +2234,7 @@ sv_compile_2op(SV *sv, OP** startop, char *code, AV** avp)
        introduced within evals. See force_ident(). GSAR 96-10-12 */
     safestr = savepv(tmpbuf);
     SAVEDELETE(defstash, safestr, strlen(safestr));
-    SAVEI32(hints);
+    SAVEHINTS();
 #ifdef OP_IN_REGISTER
     opsave = op;
 #else
@@ -2504,7 +2562,7 @@ PP(pp_require)
     rsfp = tryrsfp;
     name = savepv(name);
     SAVEFREEPV(name);
-    SAVEI32(hints);
+    SAVEHINTS();
     hints = 0;
  
     /* switch to eval mode */
@@ -2564,7 +2622,7 @@ PP(pp_entereval)
        introduced within evals. See force_ident(). GSAR 96-10-12 */
     safestr = savepv(tmpbuf);
     SAVEDELETE(defstash, safestr, strlen(safestr));
-    SAVEI32(hints);
+    SAVEHINTS();
     hints = op->op_targ;
 
     push_return(op->op_next);