Lots of consting
[p5sagit/p5-mst-13.2.git] / pp_ctl.c
index 1c582bc..a0333e6 100644 (file)
--- 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;
@@ -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)
@@ -1144,7 +1144,7 @@ PP(pp_flop)
            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);
@@ -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");
@@ -1971,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;
@@ -2030,7 +2030,7 @@ PP(pp_return)
 
     LEAVESUB(sv);
     if (clear_errsv)
-       sv_setpv(ERRSV,"");
+       sv_setpvn(ERRSV,"",0);
     return retop;
 }
 
@@ -2297,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;
@@ -2315,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);
                }
            }
@@ -2338,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++)
@@ -2362,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);
@@ -2658,9 +2663,9 @@ 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 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;
@@ -2920,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];
@@ -2940,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");
@@ -3049,9 +3054,9 @@ 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;
     const I32 gimme = GIMME_V;
@@ -3079,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");
@@ -3291,16 +3296,16 @@ 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++) {
@@ -3401,7 +3406,7 @@ PP(pp_entereval)
     CV* runcv;
     U32 seq;
 
-    if (!SvPV(sv,len))
+    if (!SvPV_const(sv,len))
        RETPUSHUNDEF;
     TAINT_PROPER("eval");
 
@@ -3526,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);
@@ -3553,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);
 }
@@ -3600,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;
 }
 
@@ -3854,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);
@@ -3946,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:
+ */