X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=pp_ctl.c;h=a4c93f13e321853b8bb016fc94a6aa0de030223f;hb=8b4f7dd5e1f209efbb2b0c869593cbad5c938b49;hp=c5f802ab74233ade99f8da3b9bf4dbfb6a10cbdc;hpb=7cc47870397ebff757d126816a8d225e8c7f5e20;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/pp_ctl.c b/pp_ctl.c
index c5f802a..a4c93f1 100644
--- 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.
@@ -939,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 */
 
@@ -1047,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)
 {
@@ -1056,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);
@@ -1066,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);
@@ -1779,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 {
@@ -2104,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;
 }
 
@@ -2171,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) {
@@ -2231,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;
@@ -2257,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
@@ -2306,7 +2329,7 @@ PP(pp_goto)
 		else {
 		    if (CvDEPTH(cv) == 100 && ckWARN(WARN_RECURSION))
 			sub_crush_depth(cv);
-		    pad_push(padlist, CvDEPTH(cv), cx->blk_sub.hasargs);
+		    pad_push(padlist, CvDEPTH(cv), 1);
 		}
 		PAD_SET_CUR(padlist, CvDEPTH(cv));
 		if (cx->blk_sub.hasargs)
@@ -2714,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;
@@ -2756,7 +2778,7 @@ Locate the CV corresponding to the currently executing sub or eval.
 If db_seqp is non_null, skip CVs that are in the DB package and populate
 *db_seqp with the cop sequence number at the point that the DB:: code was
 entered. (allows debuggers to eval in the scope of the breakpoint rather
-than in in the scope of the debuger itself).
+than in in the scope of the debugger itself).
 
 =cut
 */