debugger (step backwards)

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

diff --git a/pp_ctl.c b/pp_ctl.c
index fe6c9f6..ec21e69 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -1,7 +1,7 @@
 /*    pp_ctl.c
  *
  *    Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
- *    2000, 2001, 2002, 2003, by Larry Wall and others
+ *    2000, 2001, 2002, 2003, 2004, 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.
@@ -863,14 +863,19 @@ PP(pp_grepstart)
     ENTER;                                     /* enter outer scope */
 
     SAVETMPS;
-    /* SAVE_DEFSV does *not* suffice here for USE_5005THREADS */
-    SAVESPTR(DEFSV);
+    if (PL_op->op_private & OPpGREP_LEX)
+       SAVESPTR(PAD_SVl(PL_op->op_targ));
+    else
+       SAVE_DEFSV;
     ENTER;                                     /* enter inner scope */
     SAVEVPTR(PL_curpm);
 
     src = PL_stack_base[*PL_markstack_ptr];
     SvTEMP_off(src);
-    DEFSV = src;
+    if (PL_op->op_private & OPpGREP_LEX)
+       PAD_SVl(PL_op->op_targ) = src;
+    else
+       DEFSV = src;
 
     PUTBACK;
     if (PL_op->op_type == OP_MAPSTART)
@@ -934,8 +939,19 @@ PP(pp_mapwhile)
        }
        /* copy the new items down to the destination list */
        dst = PL_stack_base + (PL_markstack_ptr[-2] += items) - 1;
-       while (items-- > 0)
-           *dst-- = SvTEMP(TOPs) ? POPs : sv_mortalcopy(POPs);
+       if (gimme == G_ARRAY) {
+           while (items-- > 0)
+               *dst-- = SvTEMP(TOPs) ? POPs : sv_mortalcopy(POPs);
+       }
+       else { 
+           /* scalar context: we don't care about which values map returns
+            * (we use undef here). And so we certainly don't want to do mortal
+            * copies of meaningless values. */
+           while (items-- > 0) {
+               (void)POPs;
+               *dst-- = &PL_sv_undef;
+           }
+       }
     }
     LEAVE;                                     /* exit inner scope */
 
@@ -949,8 +965,15 @@ PP(pp_mapwhile)
        (void)POPMARK;                          /* pop dst */
        SP = PL_stack_base + POPMARK;           /* pop original mark */
        if (gimme == G_SCALAR) {
-           dTARGET;
-           XPUSHi(items);
+           if (PL_op->op_private & OPpGREP_LEX) {
+               SV* sv = sv_newmortal();
+               sv_setiv(sv, items);
+               PUSHs(sv);
+           }
+           else {
+               dTARGET;
+               XPUSHi(items);
+           }
        }
        else if (gimme == G_ARRAY)
            SP += items;
@@ -965,7 +988,10 @@ PP(pp_mapwhile)
        /* set $_ to the new source item */
        src = PL_stack_base[PL_markstack_ptr[-1]];
        SvTEMP_off(src);
-       DEFSV = src;
+       if (PL_op->op_private & OPpGREP_LEX)
+           PAD_SVl(PL_op->op_targ) = src;
+       else
+           DEFSV = src;
 
        RETURNOP(cLOGOP->op_other);
     }
@@ -1032,8 +1058,9 @@ PP(pp_flip)
 #define RANGE_IS_NUMERIC(left,right) ( \
        SvNIOKp(left)  || (SvOK(left)  && !SvPOKp(left))  || \
        SvNIOKp(right) || (SvOK(right) && !SvPOKp(right)) || \
-       (looks_like_number(left) && SvPOKp(left) && *SvPVX(left) != '0' && \
-        looks_like_number(right)))
+       (((!SvOK(left) && SvOK(right)) || ((!SvOK(left) || \
+          looks_like_number(left)) && SvPOKp(left) && *SvPVX(left) != '0')) \
+         && (!SvOK(right) || looks_like_number(right))))
 
 PP(pp_flop)
 {
@@ -1041,9 +1068,9 @@ PP(pp_flop)
 
     if (GIMME == G_ARRAY) {
        dPOPPOPssrl;
-       register I32 i, j;
+       register IV i, j;
        register SV *sv;
-       I32 max;
+       IV max;
 
        if (SvGMAGICAL(left))
            mg_get(left);
@@ -1051,7 +1078,8 @@ PP(pp_flop)
            mg_get(right);
 
        if (RANGE_IS_NUMERIC(left,right)) {
-           if (SvNV(left) < IV_MIN || SvNV(right) > IV_MAX)
+           if ((SvOK(left) && SvNV(left) < IV_MIN) ||
+               (SvOK(right) && SvNV(right) > IV_MAX))
                DIE(aTHX_ "Range iterator outside integer range");
            i = SvIV(left);
            max = SvIV(right);
@@ -1701,7 +1729,6 @@ PP(pp_dbstate)
        PUSHBLOCK(cx, CXt_SUB, SP);
        PUSHSUB_DB(cx);
        CvDEPTH(cv)++;
-       (void)SvREFCNT_inc(cv);
        PAD_SET_CUR(CvPADLIST(cv),1);
        RETURNOP(CvSTART(cv));
     }
@@ -1765,15 +1792,20 @@ PP(pp_enteriter)
        cx->blk_loop.iterary = (AV*)SvREFCNT_inc(POPs);
        if (SvTYPE(cx->blk_loop.iterary) != SVt_PVAV) {
            dPOPss;
-           if (RANGE_IS_NUMERIC(sv,(SV*)cx->blk_loop.iterary)) {
-                if (SvNV(sv) < IV_MIN ||
-                    SvNV((SV*)cx->blk_loop.iterary) >= IV_MAX)
-                    DIE(aTHX_ "Range iterator outside integer range");
-                cx->blk_loop.iterix = SvIV(sv);
-                cx->blk_loop.itermax = SvIV((SV*)cx->blk_loop.iterary);
+           SV *right = (SV*)cx->blk_loop.iterary;
+           if (RANGE_IS_NUMERIC(sv,right)) {
+               if ((SvOK(sv) && SvNV(sv) < IV_MIN) ||
+                   (SvOK(right) && SvNV(right) >= IV_MAX))
+                   DIE(aTHX_ "Range iterator outside integer range");
+               cx->blk_loop.iterix = SvIV(sv);
+               cx->blk_loop.itermax = SvIV(right);
            }
-           else
+           else {
+               STRLEN n_a;
                cx->blk_loop.iterlval = newSVsv(sv);
+               (void) SvPV_force(cx->blk_loop.iterlval,n_a);
+               (void) SvPV(right,n_a);
+           }
        }
     }
     else {
@@ -2090,6 +2122,7 @@ PP(pp_redo)
     TOPBLOCK(cx);
     oldsave = PL_scopestack[PL_scopestack_ix - 1];
     LEAVE_SCOPE(oldsave);
+    FREETMPS;
     return cx->blk_loop.redo_op;
 }
 
@@ -2157,6 +2190,7 @@ PP(pp_goto)
     char *label;
     int do_dump = (PL_op->op_type == OP_DUMP);
     static char must_have_label[] = "goto must have label";
+    AV *oldav = Nullav;
 
     label = 0;
     if (PL_op->op_flags & OPf_STACKED) {
@@ -2217,7 +2251,7 @@ PP(pp_goto)
                GvAV(PL_defgv) = cx->blk_sub.savearray;
                /* abandon @_ if it got reified */
                if (AvREAL(av)) {
-                   (void)sv_2mortal((SV*)av);  /* delay until return */
+                   oldav = av; /* delay until return */
                    av = newAV();
                    av_extend(av, items-1);
                    AvFLAGS(av) = AVf_REIFY;
@@ -2243,6 +2277,9 @@ PP(pp_goto)
 
            /* Now do some callish stuff. */
            SAVETMPS;
+           /* For reified @_, delay freeing till return from new sub */
+           if (oldav)
+               SAVEFREESV((SV*)oldav);
            SAVEFREESV(cv); /* later, undo the 'avoid premature free' hack */
            if (CvXSUB(cv)) {
 #ifdef PERL_XSUB_OLDSTYLE
@@ -2700,7 +2737,6 @@ Perl_sv_compile_2op(pTHX_ SV *sv, OP** startop, char *code, PAD** padp)
 #else
     SAVEVPTR(PL_op);
 #endif
-    PL_hints &= HINT_UTF8;
 
     /* we get here either during compilation, or via pp_regcomp at runtime */
     runtime = IN_PERL_RUNTIME;