X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=pp_ctl.c;h=a0333e60b6320053fc9bfdb1ba0837663b03752a;hb=5c144d81801caa5e8317f6a38b40eb08257c47ea;hp=b61769aacc456ba7748b322db9d8a8a474826631;hpb=a034e688aeb372632feafc428b392a22393dec55;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/pp_ctl.c b/pp_ctl.c
index b61769a..a0333e6 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -208,7 +208,7 @@ PP(pp_substcont)
     RX_MATCH_UTF8_set(rx, SvUTF8(cx->sb_targ));
 
     if (cx->sb_iters++) {
-	I32 saviters = cx->sb_iters;
+	const I32 saviters = cx->sb_iters;
 	if (cx->sb_iters > cx->sb_maxiters)
 	    DIE(aTHX_ "Substitution loop");
 
@@ -285,7 +285,7 @@ PP(pp_substcont)
 	MAGIC *mg;
 	I32 i;
 	if (SvTYPE(sv) < SVt_PVMG)
-	    (void)SvUPGRADE(sv, SVt_PVMG);
+	    SvUPGRADE(sv, SVt_PVMG);
 	if (!(mg = mg_find(sv, PERL_MAGIC_regex_global))) {
 	    sv_magic(sv, Nullsv, PERL_MAGIC_regex_global, Nullch, 0);
 	    mg = mg_find(sv, PERL_MAGIC_regex_global);
@@ -475,14 +475,14 @@ PP(pp_formline)
 	case FF_LITERAL:
 	    arg = *fpc++;
 	    if (targ_is_utf8 && !SvUTF8(tmpForm)) {
-		SvCUR_set(PL_formtarget, t - SvPVX(PL_formtarget));
+		SvCUR_set(PL_formtarget, t - SvPVX_const(PL_formtarget));
 		*t = '\0';
 		sv_catpvn_utf8_upgrade(PL_formtarget, f, arg, nsv);
 		t = SvEND(PL_formtarget);
 		break;
 	    }
 	    if (!targ_is_utf8 && DO_UTF8(tmpForm)) {
-		SvCUR_set(PL_formtarget, t - SvPVX(PL_formtarget));
+		SvCUR_set(PL_formtarget, t - SvPVX_const(PL_formtarget));
 		*t = '\0';
 		sv_utf8_upgrade(PL_formtarget);
 		SvGROW(PL_formtarget, SvCUR(PL_formtarget) + fudge + 1);
@@ -658,7 +658,7 @@ PP(pp_formline)
 	    s = item;
 	    if (item_is_utf8) {
 		if (!targ_is_utf8) {
-		    SvCUR_set(PL_formtarget, t - SvPVX(PL_formtarget));
+		    SvCUR_set(PL_formtarget, t - SvPVX_const(PL_formtarget));
 		    *t = '\0';
 		    sv_utf8_upgrade(PL_formtarget);
 		    SvGROW(PL_formtarget, SvCUR(PL_formtarget) + fudge + 1);
@@ -691,7 +691,7 @@ PP(pp_formline)
 		break;
 	    }
 	    if (targ_is_utf8 && !item_is_utf8) {
-		SvCUR_set(PL_formtarget, t - SvPVX(PL_formtarget));
+		SvCUR_set(PL_formtarget, t - SvPVX_const(PL_formtarget));
 		*t = '\0';
 		sv_catpvn_utf8_upgrade(PL_formtarget, s, arg, nsv);
 		for (; t < SvEND(PL_formtarget); t++) {
@@ -757,7 +757,7 @@ PP(pp_formline)
 			}
 		    }
 		}
-		SvCUR_set(PL_formtarget, t - SvPVX(PL_formtarget));
+		SvCUR_set(PL_formtarget, t - SvPVX_const(PL_formtarget));
 		if (targ_is_utf8)
 		    SvUTF8_on(PL_formtarget);
 		if (oneline) {
@@ -829,7 +829,7 @@ PP(pp_formline)
 	    if (gotsome) {
 		if (arg) {		/* repeat until fields exhausted? */
 		    *t = '\0';
-		    SvCUR_set(PL_formtarget, t - SvPVX(PL_formtarget));
+		    SvCUR_set(PL_formtarget, t - SvPVX_const(PL_formtarget));
 		    lines += FmLINES(PL_formtarget);
 		    if (lines == 200) {
 			arg = t - linemark;
@@ -865,7 +865,7 @@ PP(pp_formline)
 		}
 		s = t - 3;
 		if (strnEQ(s,"   ",3)) {
-		    while (s > SvPVX(PL_formtarget) && isSPACE(s[-1]))
+		    while (s > SvPVX_const(PL_formtarget) && isSPACE(s[-1]))
 			s--;
 		}
 		*s++ = '.';
@@ -876,7 +876,7 @@ PP(pp_formline)
 
 	case FF_END:
 	    *t = '\0';
-	    SvCUR_set(PL_formtarget, t - SvPVX(PL_formtarget));
+	    SvCUR_set(PL_formtarget, t - SvPVX_const(PL_formtarget));
 	    if (targ_is_utf8)
 		SvUTF8_on(PL_formtarget);
 	    FmLINES(PL_formtarget) += lines;
@@ -931,7 +931,7 @@ PP(pp_mapstart)
 PP(pp_mapwhile)
 {
     dVAR; dSP;
-    I32 gimme = GIMME_V;
+    const I32 gimme = GIMME_V;
     I32 items = (SP - PL_stack_base) - *PL_markstack_ptr; /* how many new items */
     I32 count;
     I32 shift;
@@ -1085,7 +1085,7 @@ PP(pp_flip)
 		RETURNOP(((LOGOP*)cUNOP->op_first)->op_other);
 	    }
 	}
-	sv_setpv(TARG, "");
+	sv_setpvn(TARG, "", 0);
 	SETs(targ);
 	RETURN;
     }
@@ -1099,7 +1099,7 @@ PP(pp_flip)
 	SvNIOKp(left)  || (SvOK(left)  && !SvPOKp(left))  || \
 	SvNIOKp(right) || (SvOK(right) && !SvPOKp(right)) || \
 	(((!SvOK(left) && SvOK(right)) || ((!SvOK(left) || \
-          looks_like_number(left)) && SvPOKp(left) && *SvPVX(left) != '0')) \
+          looks_like_number(left)) && SvPOKp(left) && *SvPVX_const(left) != '0')) \
          && (!SvOK(right) || looks_like_number(right))))
 
 PP(pp_flop)
@@ -1138,13 +1138,13 @@ PP(pp_flop)
 	else {
 	    SV *final = sv_mortalcopy(right);
 	    STRLEN len, n_a;
-	    char *tmps = SvPV(final, len);
+	    const char *tmps = SvPV(final, len);
 
 	    sv = sv_mortalcopy(left);
 	    SvPV_force(sv,n_a);
 	    while (!SvNIOKp(sv) && SvCUR(sv) <= len) {
 		XPUSHs(sv);
-	        if (strEQ(SvPVX(sv),tmps))
+	        if (strEQ(SvPVX_const(sv),tmps))
 	            break;
 		sv = sv_2mortal(newSVsv(sv));
 		sv_inc(sv);
@@ -1228,7 +1228,7 @@ S_dopoptolabel(pTHX_ const char *label)
 I32
 Perl_dowantarray(pTHX)
 {
-    I32 gimme = block_gimme();
+    const I32 gimme = block_gimme();
     return (gimme == G_VOID) ? G_SCALAR : gimme;
 }
 
@@ -1397,7 +1397,7 @@ Perl_die_where(pTHX_ const char *message, STRLEN msglen)
 		SV *err = ERRSV;
                 const char *e = Nullch;
 		if (!SvPOK(err))
-		    sv_setpv(err,"");
+		    sv_setpvn(err,"",0);
 		else if (SvCUR(err) >= sizeof(prefix)+msglen-1) {
 		    e = SvPV(err, n_a);
 		    e += n_a - msglen;
@@ -1409,8 +1409,8 @@ Perl_die_where(pTHX_ const char *message, STRLEN msglen)
 		    sv_catpvn(err, prefix, sizeof(prefix)-1);
 		    sv_catpvn(err, message, msglen);
 		    if (ckWARN(WARN_MISC)) {
-			STRLEN start = SvCUR(err)-msglen-sizeof(prefix)+1;
-			Perl_warner(aTHX_ packWARN(WARN_MISC), SvPVX(err)+start);
+			const STRLEN start = SvCUR(err)-msglen-sizeof(prefix)+1;
+			Perl_warner(aTHX_ packWARN(WARN_MISC), SvPVX_const(err)+start);
 		    }
 		}
 	    }
@@ -1458,7 +1458,7 @@ Perl_die_where(pTHX_ const char *message, STRLEN msglen)
 	    if (optype == OP_REQUIRE) {
                 const char* msg = SvPVx(ERRSV, n_a);
                 SV *nsv = cx->blk_eval.old_namesv;
-                (void)hv_store(GvHVn(PL_incgv), SvPVX(nsv), SvCUR(nsv),
+                (void)hv_store(GvHVn(PL_incgv), SvPVX_const(nsv), SvCUR(nsv),
                                &PL_sv_undef, 0);
 		DIE(aTHX_ "%sCompilation failed in require",
 		    *msg ? msg : "Unknown error\n");
@@ -1543,10 +1543,8 @@ PP(pp_caller)
     register PERL_CONTEXT *cx;
     register PERL_CONTEXT *ccstack = cxstack;
     PERL_SI *top_si = PL_curstackinfo;
-    I32 dbcxix;
     I32 gimme;
     const char *stashname;
-    SV *sv;
     I32 count = 0;
 
     if (MAXARG)
@@ -1577,7 +1575,7 @@ PP(pp_caller)
 
     cx = &ccstack[cxix];
     if (CxTYPE(cx) == CXt_SUB || CxTYPE(cx) == CXt_FORMAT) {
-        dbcxix = dopoptosub_at(ccstack, cxix - 1);
+        const I32 dbcxix = dopoptosub_at(ccstack, cxix - 1);
 	/* We expect that ccstack[dbcxix] is CXt_SUB, anyway, the
 	   field below is defined for any cx. */
 	/* caller() should not report the automatic calls to &DB::sub */
@@ -1612,7 +1610,7 @@ PP(pp_caller)
 	GV *cvgv = CvGV(ccstack[cxix].blk_sub.cv);
 	/* So is ccstack[dbcxix]. */
 	if (isGV(cvgv)) {
-	    sv = NEWSV(49, 0);
+	    SV * const sv = NEWSV(49, 0);
 	    gv_efullname3(sv, cvgv, Nullch);
 	    PUSHs(sv_2mortal(sv));
 	    PUSHs(sv_2mortal(newSViv((I32)cx->blk_sub.hasargs)));
@@ -1739,7 +1737,7 @@ PP(pp_dbstate)
 	dSP;
 	register CV *cv;
 	register PERL_CONTEXT *cx;
-	I32 gimme = G_ARRAY;
+	const I32 gimme = G_ARRAY;
 	U8 hasargs;
 	GV *gv;
 
@@ -1781,7 +1779,7 @@ PP(pp_enteriter)
 {
     dVAR; dSP; dMARK;
     register PERL_CONTEXT *cx;
-    I32 gimme = GIMME_V;
+    const I32 gimme = GIMME_V;
     SV **svp;
     U32 cxtype = CXt_LOOP;
 #ifdef USE_ITHREADS
@@ -1868,7 +1866,7 @@ PP(pp_enterloop)
 {
     dVAR; dSP;
     register PERL_CONTEXT *cx;
-    I32 gimme = GIMME_V;
+    const I32 gimme = GIMME_V;
 
     ENTER;
     SAVETMPS;
@@ -1973,7 +1971,7 @@ PP(pp_return)
 	{
 	    /* Unassume the success we assumed earlier. */
 	    SV *nsv = cx->blk_eval.old_namesv;
-	    (void)hv_delete(GvHVn(PL_incgv), SvPVX(nsv), SvCUR(nsv), G_DISCARD);
+	    (void)hv_delete(GvHVn(PL_incgv), SvPVX_const(nsv), SvCUR(nsv), G_DISCARD);
 	    DIE(aTHX_ "%"SVf" did not return a true value", nsv);
 	}
 	break;
@@ -2032,7 +2030,7 @@ PP(pp_return)
 
     LEAVESUB(sv);
     if (clear_errsv)
-	sv_setpv(ERRSV,"");
+	sv_setpvn(ERRSV,"",0);
     return retop;
 }
 
@@ -2299,8 +2297,14 @@ PP(pp_goto)
 	    if (cxix < cxstack_ix)
 		dounwind(cxix);
 	    TOPBLOCK(cx);
-	    if (CxREALEVAL(cx))
-		DIE(aTHX_ "Can't goto subroutine from an eval-string");
+	    SPAGAIN;
+	    /* ban goto in eval: see <20050521150056.GC20213@iabyn.com> */
+	    if (CxTYPE(cx) == CXt_EVAL) {
+		if (CxREALEVAL(cx))
+		    DIE(aTHX_ "Can't goto subroutine from an eval-string");
+		else
+		    DIE(aTHX_ "Can't goto subroutine from an eval-block");
+	    }
 	    if (CxTYPE(cx) == CXt_SUB && cx->blk_sub.hasargs) {
 		/* put @_ back onto stack */
 		AV* av = cx->blk_sub.argarray;
@@ -2317,7 +2321,7 @@ PP(pp_goto)
 		    SvREFCNT_dec(av);
 		    av = newAV();
 		    av_extend(av, items-1);
-		    AvFLAGS(av) = AVf_REIFY;
+		    AvREIFY_only(av);
 		    PAD_SVl(0) = (SV*)(cx->blk_sub.argarray = av);
 		}
 	    }
@@ -2340,6 +2344,7 @@ PP(pp_goto)
 	    SAVETMPS;
 	    SAVEFREESV(cv); /* later, undo the 'avoid premature free' hack */
 	    if (CvXSUB(cv)) {
+		OP* retop = cx->blk_sub.retop;
 		if (reified) {
 		    I32 index;
 		    for (index=0; index<items; index++)
@@ -2364,17 +2369,15 @@ PP(pp_goto)
 		    SV **newsp;
 		    I32 gimme;
 
+		    /* XS subs don't have a CxSUB, so pop it */
+		    POPBLOCK(cx, PL_curpm);
 		    /* Push a mark for the start of arglist */
 		    PUSHMARK(mark);
 		    PUTBACK;
 		    (void)(*CvXSUB(cv))(aTHX_ cv);
-		    /* Pop the current context like a decent sub should */
-		    POPBLOCK(cx, PL_curpm);
-		    /* Do _not_ use PUTBACK, keep the XSUB's return stack! */
 		}
 		LEAVE;
-		assert(CxTYPE(cx) == CXt_SUB);
-		return cx->blk_sub.retop;
+		return retop;
 	    }
 	    else {
 		AV* padlist = CvPADLIST(cv);
@@ -2618,7 +2621,7 @@ PP(pp_exit)
 PP(pp_nswitch)
 {
     dSP;
-    NV value = SvNVx(GvSV(cCOP->cop_gv));
+    const NV value = SvNVx(GvSV(cCOP->cop_gv));
     register I32 match = I_32(value);
 
     if (value < 0.0) {
@@ -2660,12 +2663,12 @@ PP(pp_cswitch)
 STATIC void
 S_save_lines(pTHX_ AV *array, SV *sv)
 {
-    register const char *s = SvPVX(sv);
-    register const char *send = SvPVX(sv) + SvCUR(sv);
-    register const char *t;
-    register I32 line = 1;
+    const char *s = SvPVX_const(sv);
+    const char *send = SvPVX_const(sv) + SvCUR(sv);
+    I32 line = 1;
 
     while (s && s < send) {
+	const char *t;
 	SV *tmpstr = NEWSV(85,0);
 
 	sv_upgrade(tmpstr, SVt_PVMG);
@@ -2922,7 +2925,7 @@ S_doeval(pTHX_ int gimme, OP** startop, CV* outside, U32 seq)
     if (saveop && saveop->op_flags & OPf_SPECIAL)
 	PL_in_eval |= EVAL_KEEPERR;
     else
-	sv_setpv(ERRSV,"");
+	sv_setpvn(ERRSV,"",0);
     if (yyparse() || PL_error_count || !PL_eval_root) {
 	SV **newsp;			/* Used by POPBLOCK. */
        PERL_CONTEXT *cx = &cxstack[cxstack_ix];
@@ -2942,9 +2945,9 @@ S_doeval(pTHX_ int gimme, OP** startop, CV* outside, U32 seq)
 	lex_end();
 	LEAVE;
 	if (optype == OP_REQUIRE) {
-            const char* msg = SvPVx(ERRSV, n_a);
-           SV *nsv = cx->blk_eval.old_namesv;
-           (void)hv_store(GvHVn(PL_incgv), SvPVX(nsv), SvCUR(nsv),
+	    const char* const msg = SvPVx(ERRSV, n_a);
+	    const SV * const nsv = cx->blk_eval.old_namesv;
+	    (void)hv_store(GvHVn(PL_incgv), SvPVX_const(nsv), SvCUR(nsv),
                           &PL_sv_undef, 0);
 	    DIE(aTHX_ "%sCompilation failed in require",
 		*msg ? msg : "Unknown error\n");
@@ -3014,7 +3017,7 @@ STATIC PerlIO *
 S_doopen_pm(pTHX_ const char *name, const char *mode)
 {
 #ifndef PERL_DISABLE_PMC
-    STRLEN namelen = strlen(name);
+    const STRLEN namelen = strlen(name);
     PerlIO *fp;
 
     if (namelen > 3 && strEQ(name + namelen - 3, ".pm")) {
@@ -3051,14 +3054,13 @@ PP(pp_require)
     dVAR; dSP;
     register PERL_CONTEXT *cx;
     SV *sv;
-    char *name;
+    const char *name;
     STRLEN len;
-    char *tryname = Nullch;
+    const char *tryname = Nullch;
     SV *namesv = Nullsv;
     SV** svp;
-    I32 gimme = GIMME_V;
+    const I32 gimme = GIMME_V;
     PerlIO *tryrsfp = 0;
-    STRLEN n_a;
     int filter_has_file = 0;
     GV *filter_child_proc = 0;
     SV *filter_state = 0;
@@ -3082,7 +3084,7 @@ PP(pp_require)
 
 	    RETPUSHYES;
     }
-    name = SvPV(sv, len);
+    name = SvPV_const(sv, len);
     if (!(name && len > 0 && *name))
 	DIE(aTHX_ "Null filename used");
     TAINT_PROPER("require");
@@ -3243,6 +3245,7 @@ PP(pp_require)
 			|| (*name == ':' && name[1] != ':' && strchr(name+2, ':'))
 #endif
 		  ) {
+		    STRLEN n_a;
 		    char *dir = SvPVx(dirsv, n_a);
 #ifdef MACOS_TRADITIONAL
 		    char buf1[256];
@@ -3293,20 +3296,21 @@ PP(pp_require)
     SvREFCNT_dec(namesv);
     if (!tryrsfp) {
 	if (PL_op->op_type == OP_REQUIRE) {
-	    char *msgstr = name;
+	    const char *msgstr = name;
 	    if (namesv) {			/* did we lookup @INC? */
 		SV *msg = sv_2mortal(newSVpv(msgstr,0));
 		SV *dirmsgsv = NEWSV(0, 0);
 		AV *ar = GvAVn(PL_incgv);
 		I32 i;
 		sv_catpvn(msg, " in @INC", 8);
-		if (instr(SvPVX(msg), ".h "))
+		if (instr(SvPVX_const(msg), ".h "))
 		    sv_catpv(msg, " (change .h to .ph maybe?)");
-		if (instr(SvPVX(msg), ".ph "))
+		if (instr(SvPVX_const(msg), ".ph "))
 		    sv_catpv(msg, " (did you run h2ph?)");
 		sv_catpv(msg, " (@INC contains:");
 		for (i = 0; i <= AvFILL(ar); i++) {
-		    char *dir = SvPVx(*av_fetch(ar, i, TRUE), n_a);
+		    STRLEN n_a;
+		    const char *dir = SvPVx(*av_fetch(ar, i, TRUE), n_a);
 		    Perl_sv_setpvf(aTHX_ dirmsgsv, " %s", dir);
 		    sv_catsv(msg, dirmsgsv);
 		}
@@ -3393,7 +3397,7 @@ PP(pp_entereval)
     dVAR; dSP;
     register PERL_CONTEXT *cx;
     dPOPss;
-    I32 gimme = GIMME_V, was = PL_sub_generation;
+    const I32 gimme = GIMME_V, was = PL_sub_generation;
     char tbuf[TYPE_DIGITS(long) + 12];
     char *tmpbuf = tbuf;
     char *safestr;
@@ -3402,7 +3406,7 @@ PP(pp_entereval)
     CV* runcv;
     U32 seq;
 
-    if (!SvPV(sv,len))
+    if (!SvPV_const(sv,len))
 	RETPUSHUNDEF;
     TAINT_PROPER("eval");
 
@@ -3527,14 +3531,14 @@ PP(pp_leaveeval)
     {
 	/* Unassume the success we assumed earlier. */
 	SV *nsv = cx->blk_eval.old_namesv;
-	(void)hv_delete(GvHVn(PL_incgv), SvPVX(nsv), SvCUR(nsv), G_DISCARD);
+	(void)hv_delete(GvHVn(PL_incgv), SvPVX_const(nsv), SvCUR(nsv), G_DISCARD);
 	retop = Perl_die(aTHX_ "%"SVf" did not return a true value", nsv);
 	/* die_where() did LEAVE, or we won't be here */
     }
     else {
 	LEAVE;
 	if (!(save_flags & OPf_SPECIAL))
-	    sv_setpv(ERRSV,"");
+	    sv_setpvn(ERRSV,"",0);
     }
 
     RETURNOP(retop);
@@ -3544,7 +3548,7 @@ PP(pp_entertry)
 {
     dVAR; dSP;
     register PERL_CONTEXT *cx;
-    I32 gimme = GIMME_V;
+    const I32 gimme = GIMME_V;
 
     ENTER;
     SAVETMPS;
@@ -3554,7 +3558,7 @@ PP(pp_entertry)
     cx->blk_eval.retop = cLOGOP->op_other->op_next;
 
     PL_in_eval = EVAL_INEVAL;
-    sv_setpv(ERRSV,"");
+    sv_setpvn(ERRSV,"",0);
     PUTBACK;
     return DOCATCH(PL_op->op_next);
 }
@@ -3601,7 +3605,7 @@ PP(pp_leavetry)
     PL_curpm = newpm;	/* Don't pop $1 et al till now */
 
     LEAVE;
-    sv_setpv(ERRSV,"");
+    sv_setpvn(ERRSV,"",0);
     RETURN;
 }
 
@@ -3855,7 +3859,7 @@ run_user_filter(pTHX_ int idx, SV *buf_sv, int maxlen)
 {
     dVAR;
     SV *datasv = FILTER_DATA(idx);
-    int filter_has_file = IoLINES(datasv);
+    const int filter_has_file = IoLINES(datasv);
     GV *filter_child_proc = (GV *)IoFMT_GV(datasv);
     SV *filter_state = (SV *)IoTOP_GV(datasv);
     SV *filter_sub = (SV *)IoBOTTOM_GV(datasv);
@@ -3947,5 +3951,5 @@ S_path_is_absolute(pTHX_ const char *name)
  * indent-tabs-mode: t
  * End:
  *
- * vim: shiftwidth=4:
-*/
+ * ex: set ts=8 sts=4 sw=4 noet:
+ */