X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=pp_ctl.c;h=e849e33c6834f205b61c8f4ffd77a8de7d025cf0;hb=8e52752b5f49a78716f0f99e5101dfe233b32cb0;hp=80cd803c83d501f347ab5fef0e1173bb01690a7a;hpb=bbed91b518d7e52e6a0a7b19d9b2fe8fd8ca6d17;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/pp_ctl.c b/pp_ctl.c
index 80cd803..e849e33 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -26,12 +26,6 @@
 
 #define DOCATCH(o) ((CATCH_GET == TRUE) ? docatch(o) : (o))
 
-#ifdef PERL_OBJECT
-#define CALLOP this->*PL_op
-#else
-#define CALLOP *PL_op
-#endif
-
 static I32 sortcv(pTHXo_ SV *a, SV *b);
 static I32 sv_ncmp(pTHXo_ SV *a, SV *b);
 static I32 sv_i_ncmp(pTHXo_ SV *a, SV *b);
@@ -229,12 +223,12 @@ Perl_rxres_save(pTHX_ void **rsp, REGEXP *rx)
 	*rsp = (void*)p;
     }
 
-    *p++ = (UV)(RX_MATCH_COPIED(rx) ? rx->subbeg : Nullch);
+    *p++ = PTR2UV(RX_MATCH_COPIED(rx) ? rx->subbeg : Nullch);
     RX_MATCH_COPIED_off(rx);
 
     *p++ = rx->nparens;
 
-    *p++ = (UV)rx->subbeg;
+    *p++ = PTR2UV(rx->subbeg);
     *p++ = (UV)rx->sublen;
     for (i = 0; i <= rx->nparens; ++i) {
 	*p++ = (UV)rx->startp[i];
@@ -255,7 +249,7 @@ Perl_rxres_restore(pTHX_ void **rsp, REGEXP *rx)
 
     rx->nparens = *p++;
 
-    rx->subbeg = (char*)(*p++);
+    rx->subbeg = INT2PTR(char*,*p++);
     rx->sublen = (I32)(*p++);
     for (i = 0; i <= rx->nparens; ++i) {
 	rx->startp[i] = (I32)(*p++);
@@ -269,7 +263,7 @@ Perl_rxres_free(pTHX_ void **rsp)
     UV *p = (UV*)*rsp;
 
     if (p) {
-	Safefree((char*)(*p));
+	Safefree(INT2PTR(char*,*p));
 	Safefree(p);
 	*rsp = Null(void*);
     }
@@ -588,10 +582,10 @@ PP(pp_formline)
 		RESTORE_NUMERIC_LOCAL();
 #if defined(USE_LONG_DOUBLE)
 		if (arg & 256) {
-		    sprintf(t, "%#*.*Lf",
+		    sprintf(t, "%#*.*" PERL_PRIfldbl,
 			    (int) fieldsize, (int) arg & 255, value);
 		} else {
-		    sprintf(t, "%*.0Lf", (int) fieldsize, value);
+		    sprintf(t, "%*.0" PERL_PRIfldbl, (int) fieldsize, value);
 		}
 #else
 		if (arg & 256) {
@@ -977,7 +971,7 @@ PP(pp_flop)
 	  (looks_like_number(left) && *SvPVX(left) != '0') )
 	{
 	    if (SvNV(left) < IV_MIN || SvNV(right) > IV_MAX)
-		Perl_croak(aTHX_ "Range iterator outside integer range");
+		DIE(aTHX_ "Range iterator outside integer range");
 	    i = SvIV(left);
 	    max = SvIV(right);
 	    if (max >= i) {
@@ -1253,6 +1247,18 @@ S_free_closures(pTHX)
     }
 }
 
+void
+Perl_qerror(pTHX_ SV *err)
+{
+    if (PL_in_eval)
+	sv_catsv(ERRSV, err);
+    else if (PL_errors)
+	sv_catsv(PL_errors, err);
+    else
+	Perl_warn(aTHX_ "%_", err);
+    ++PL_error_count;
+}
+
 OP *
 Perl_die_where(pTHX_ char *message, STRLEN msglen)
 {
@@ -1294,7 +1300,9 @@ Perl_die_where(pTHX_ char *message, STRLEN msglen)
 	else
 	    message = SvPVx(ERRSV, msglen);
 
-	while ((cxix = dopoptoeval(cxstack_ix)) < 0 && PL_curstackinfo->si_prev) {
+	while ((cxix = dopoptoeval(cxstack_ix)) < 0
+	       && PL_curstackinfo->si_prev)
+	{
 	    dounwind(-1);
 	    POPSTACK;
 	}
@@ -1321,7 +1329,8 @@ Perl_die_where(pTHX_ char *message, STRLEN msglen)
 
 	    if (optype == OP_REQUIRE) {
 		char* msg = SvPVx(ERRSV, n_a);
-		DIE(aTHX_ "%s", *msg ? msg : "Compilation failed in require");
+		DIE(aTHX_ "%sCompilation failed in require",
+		    *msg ? msg : "Unknown error\n");
 	    }
 	    return pop_return();
 	}
@@ -1607,7 +1616,7 @@ PP(pp_enteriter)
 		(looks_like_number(sv) && *SvPVX(sv) != '0')) {
 		 if (SvNV(sv) < IV_MIN ||
 		     SvNV((SV*)cx->blk_loop.iterary) >= IV_MAX)
-		     Perl_croak(aTHX_ "Range iterator outside integer range");
+		     DIE(aTHX_ "Range iterator outside integer range");
 		 cx->blk_loop.iterix = SvIV(sv);
 		 cx->blk_loop.itermax = SvIV((SV*)cx->blk_loop.iterary);
 	    }
@@ -1921,32 +1930,29 @@ S_dofindlabel(pTHX_ OP *o, char *label, OP **opstack, OP **oplimit)
 	*ops++ = cUNOPo->op_first;
 	if (ops >= oplimit)
 	    Perl_croak(aTHX_ too_deep);
-	*ops = 0;
     }
+    *ops = 0;
     if (o->op_flags & OPf_KIDS) {
 	dTHR;
 	/* First try all the kids at this level, since that's likeliest. */
 	for (kid = cUNOPo->op_first; kid; kid = kid->op_sibling) {
-	    if ((kid->op_type == OP_NEXTSTATE || kid->op_type == OP_DBSTATE)
-		&& kCOP->cop_label && strEQ(kCOP->cop_label, label))
-	    {
+	    if ((kid->op_type == OP_NEXTSTATE || kid->op_type == OP_DBSTATE) &&
+		    kCOP->cop_label && strEQ(kCOP->cop_label, label))
 		return kid;
-	    }
 	}
 	for (kid = cUNOPo->op_first; kid; kid = kid->op_sibling) {
 	    if (kid == PL_lastgotoprobe)
 		continue;
-	    if ((kid->op_type == OP_NEXTSTATE || kid->op_type == OP_DBSTATE)
-		&& (ops == opstack || (ops[-1]->op_type != OP_NEXTSTATE
-				       && ops[-1]->op_type != OP_DBSTATE)))
-	    {
+	    if ((kid->op_type == OP_NEXTSTATE || kid->op_type == OP_DBSTATE) &&
+		(ops == opstack ||
+		 (ops[-1]->op_type != OP_NEXTSTATE &&
+		  ops[-1]->op_type != OP_DBSTATE)))
 		*ops++ = kid;
-		*ops = 0;
-	    }
 	    if (o = dofindlabel(kid, label, ops, oplimit))
 		return o;
 	}
     }
+    *ops = 0;
     return 0;
 }
 
@@ -1981,7 +1987,6 @@ PP(pp_goto)
 	    SV** mark;
 	    I32 items = 0;
 	    I32 oldsave;
-	    int arg_was_real = 0;
 
 	retry:
 	    if (!CvROOT(cv) && !CvXSUB(cv)) {
@@ -2013,8 +2018,8 @@ PP(pp_goto)
 	    if (CxTYPE(cx) == CXt_EVAL && cx->blk_eval.old_op_type == OP_ENTEREVAL) 
 		DIE(aTHX_ "Can't goto subroutine from an eval-string");
 	    mark = PL_stack_sp;
-	    if (CxTYPE(cx) == CXt_SUB &&
-		cx->blk_sub.hasargs) {   /* put @_ back onto stack */
+	    if (CxTYPE(cx) == CXt_SUB && cx->blk_sub.hasargs) {
+		/* put @_ back onto stack */
 		AV* av = cx->blk_sub.argarray;
 		
 		items = AvFILLp(av) + 1;
@@ -2026,11 +2031,14 @@ PP(pp_goto)
 		SvREFCNT_dec(GvAV(PL_defgv));
 		GvAV(PL_defgv) = cx->blk_sub.savearray;
 #endif /* USE_THREADS */
+		/* abandon @_ if it got reified */
 		if (AvREAL(av)) {
-		    arg_was_real = 1;
-		    AvREAL_off(av);	/* so av_clear() won't clobber elts */
+		    (void)sv_2mortal((SV*)av);	/* delay until return */
+		    av = newAV();
+		    av_extend(av, items-1);
+		    AvFLAGS(av) = AVf_REIFY;
+		    PL_curpad[0] = (SV*)(cx->blk_sub.argarray = av);
 		}
-		av_clear(av);
 	    }
 	    else if (CvXSUB(cv)) {	/* put GvAV(defgv) back onto stack */
 		AV* av;
@@ -2188,11 +2196,7 @@ PP(pp_goto)
 		    }
 		    Copy(mark,AvARRAY(av),items,SV*);
 		    AvFILLp(av) = items - 1;
-		    /* preserve @_ nature */
-		    if (arg_was_real) {
-			AvREIFY_off(av);
-			AvREAL_on(av);
-		    }
+		    assert(!AvREAL(av));
 		    while (items--) {
 			if (*mark)
 			    SvTEMP_off(*mark);
@@ -2208,7 +2212,7 @@ PP(pp_goto)
 		    CV *gotocv;
 		    
 		    if (PERLDB_SUB_NN) {
-			SvIVX(sv) = (IV)cv; /* Already upgraded, saved */
+			SvIVX(sv) = PTR2IV(cv); /* Already upgraded, saved */
 		    } else {
 			save_item(sv);
 			gv_efullname3(sv, CvGV(cv), Nullch);
@@ -2307,7 +2311,7 @@ PP(pp_goto)
 		if (PL_op->op_type == OP_ENTERITER)
 		    DIE(aTHX_ "Can't \"goto\" into the middle of a foreach loop",
 			label);
-		(CALLOP->op_ppaddr)(aTHX);
+		CALL_FPTR(PL_op->op_ppaddr)(aTHX);
 	    }
 	    PL_op = oldop;
 	}
@@ -2636,13 +2640,16 @@ S_doeval(pTHX_ int gimme, OP** startop)
 	LEAVE;
 	if (optype == OP_REQUIRE) {
 	    char* msg = SvPVx(ERRSV, n_a);
-	    DIE(aTHX_ "%s", *msg ? msg : "Compilation failed in require");
-	} else if (startop) {
+	    DIE(aTHX_ "%sCompilation failed in require",
+		*msg ? msg : "Unknown error\n");
+	}
+	else if (startop) {
 	    char* msg = SvPVx(ERRSV, n_a);
 
 	    POPBLOCK(cx,PL_curpm);
 	    POPEVAL(cx);
-	    Perl_croak(aTHX_ "%sCompilation failed in regexp", (*msg ? msg : "Unknown error\n"));
+	    Perl_croak(aTHX_ "%sCompilation failed in regexp",
+		       (*msg ? msg : "Unknown error\n"));
 	}
 	SvREFCNT_dec(PL_rs);
 	PL_rs = SvREFCNT_inc(PL_nrs);
@@ -2848,7 +2855,7 @@ PP(pp_require)
 				       save the gv to manage the lifespan of
 				       the pipe, but this didn't help. XXX */
 				    filter_child_proc = (GV *)arg;
-				    SvREFCNT_inc(filter_child_proc);
+				    (void)SvREFCNT_inc(filter_child_proc);
 				}
 				else {
 				    if (IoOFP(io) && IoOFP(io) != IoIFP(io)) {
@@ -2866,11 +2873,11 @@ PP(pp_require)
 
 			if (SvROK(arg) && SvTYPE(SvRV(arg)) == SVt_PVCV) {
 			    filter_sub = arg;
-			    SvREFCNT_inc(filter_sub);
+			    (void)SvREFCNT_inc(filter_sub);
 
 			    if (i < count) {
 				filter_state = SP[i];
-				SvREFCNT_inc(filter_state);
+				(void)SvREFCNT_inc(filter_state);
 			    }
 
 			    if (tryrsfp == 0) {