Add a dump to help tracing taint bugs, by Chip Salzenberg
[p5sagit/p5-mst-13.2.git] / pp_ctl.c
index 8ddb2c4..3ef7e32 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -9,12 +9,14 @@
  */
 
 /*
- * Now far ahead the Road has gone,
- * And I must follow, if I can,
- * Pursuing it with eager feet,
- * Until it joins some larger way
- * Where many paths and errands meet.
- * And whither then?  I cannot say.
+ *      Now far ahead the Road has gone,
+ *          And I must follow, if I can,
+ *      Pursuing it with eager feet,
+ *          Until it joins some larger way
+ *      Where many paths and errands meet.
+ *          And whither then?  I cannot say.
+ *
+ *     [Bilbo on p.35 of _The Lord of the Rings_, I/i: "A Long-Expected Party"]
  */
 
 /* This file contains control-oriented pp ("push/pop") functions that
@@ -95,7 +97,7 @@ PP(pp_regcomp)
        /* multiple args; concatentate them */
        dMARK; dORIGMARK;
        tmpstr = PAD_SV(ARGTARG);
-       sv_setpvn(tmpstr, "", 0);
+       sv_setpvs(tmpstr, "");
        while (++MARK <= SP) {
            if (PL_amagic_generation) {
                SV *sv;
@@ -986,7 +988,7 @@ PP(pp_grepstart)
     if (PL_op->op_private & OPpGREP_LEX)
        PAD_SVl(PL_op->op_targ) = src;
     else
-       DEFSV = src;
+       DEFSV_set(src);
 
     PUTBACK;
     if (PL_op->op_type == OP_MAPSTART)
@@ -1097,7 +1099,7 @@ PP(pp_mapwhile)
        if (PL_op->op_private & OPpGREP_LEX)
            PAD_SVl(PL_op->op_targ) = src;
        else
-           DEFSV = src;
+           DEFSV_set(src);
 
        RETURNOP(cLOGOP->op_other);
     }
@@ -1154,7 +1156,7 @@ PP(pp_flip)
                RETURNOP(((LOGOP*)cUNOP->op_first)->op_other);
            }
        }
-       sv_setpvn(TARG, "", 0);
+       sv_setpvs(TARG, "");
        SETs(targ);
        RETURN;
     }
@@ -1537,7 +1539,7 @@ Perl_die_where(pTHX_ const char *message, STRLEN msglen)
                SV * const err = ERRSV;
                const char *e = NULL;
                if (!SvPOK(err))
-                   sv_setpvn(err,"",0);
+                   sv_setpvs(err,"");
                else if (SvCUR(err) >= sizeof(prefix)+msglen-1) {
                    STRLEN len;
                    e = SvPV_const(err, len);
@@ -1551,7 +1553,8 @@ Perl_die_where(pTHX_ const char *message, STRLEN msglen)
                    sv_catpvn(err, message, msglen);
                    if (ckWARN(WARN_MISC)) {
                        const STRLEN start = SvCUR(err)-msglen-sizeof(prefix)+1;
-                       Perl_warner(aTHX_ packWARN(WARN_MISC), SvPVX_const(err)+start);
+                       Perl_warner(aTHX_ packWARN(WARN_MISC), "%s",
+                               SvPVX_const(err)+start);
                    }
                }
            }
@@ -1791,8 +1794,8 @@ PP(pp_caller)
 
     PUSHs(cx->blk_oldcop->cop_hints_hash ?
          sv_2mortal(newRV_noinc(
-           (SV*)Perl_refcounted_he_chain_2hv(aTHX_
-                                             cx->blk_oldcop->cop_hints_hash)))
+                                MUTABLE_SV(Perl_refcounted_he_chain_2hv(aTHX_
+                                             cx->blk_oldcop->cop_hints_hash))))
          : &PL_sv_undef);
     RETURN;
 }
@@ -1894,7 +1897,7 @@ PP(pp_enteriter)
 #endif
     }
     else {
-       GV * const gv = (GV*)POPs;
+       GV * const gv = MUTABLE_GV(POPs);
        svp = &GvSV(gv);                        /* symbol table variable */
        SAVEGENERICSV(*svp);
        *svp = newSV(0);
@@ -1976,7 +1979,7 @@ PP(pp_enteriter)
            }
        }
        else /* SvTYPE(maybe_ary) == SVt_PVAV */ {
-           cx->blk_loop.state_u.ary.ary = (AV*)maybe_ary;
+           cx->blk_loop.state_u.ary.ary = MUTABLE_AV(maybe_ary);
            SvREFCNT_inc(maybe_ary);
            cx->blk_loop.state_u.ary.ix =
                (PL_op->op_private & OPpITER_REVERSED) ?
@@ -2412,7 +2415,7 @@ PP(pp_goto)
        if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVCV) {
            I32 cxix;
            register PERL_CONTEXT *cx;
-           CV* cv = (CV*)SvRV(sv);
+           CV *cv = MUTABLE_CV(SvRV(sv));
            SV** mark;
            I32 items = 0;
            I32 oldsave;
@@ -2474,7 +2477,7 @@ PP(pp_goto)
                    av = newAV();
                    av_extend(av, items-1);
                    AvREIFY_only(av);
-                   PAD_SVl(0) = (SV*)(cx->blk_sub.argarray = av);
+                   PAD_SVl(0) = MUTABLE_SV(cx->blk_sub.argarray = av);
                }
            }
            else if (CvISXSUB(cv)) {    /* put GvAV(defgv) back onto stack */
@@ -2535,10 +2538,10 @@ PP(pp_goto)
                PAD_SET_CUR_NOSAVE(padlist, CvDEPTH(cv));
                if (CxHASARGS(cx))
                {
-                   AV* const av = (AV*)PAD_SVl(0);
+                   AV *const av = MUTABLE_AV(PAD_SVl(0));
 
                    cx->blk_sub.savearray = GvAV(PL_defgv);
-                   GvAV(PL_defgv) = (AV*)SvREFCNT_inc_simple(av);
+                   GvAV(PL_defgv) = MUTABLE_AV(SvREFCNT_inc_simple(av));
                    CX_CURPAD_SAVE(cx->blk_sub);
                    cx->blk_sub.argarray = av;
 
@@ -2576,7 +2579,7 @@ PP(pp_goto)
                        CV * const gotocv = get_cv("DB::goto", FALSE);
                        if (gotocv) {
                            PUSHMARK( PL_stack_sp );
-                           call_sv((SV*)gotocv, G_SCALAR | G_NODEBUG);
+                           call_sv(MUTABLE_SV(gotocv), G_SCALAR | G_NODEBUG);
                            PL_stack_sp--;
                        }
                    }
@@ -2906,7 +2909,7 @@ Perl_sv_compile_2op(pTHX_ SV *sv, OP** startop, const char *code, PAD** padp)
     (*startop)->op_ppaddr = PL_ppaddr[OP_NULL];
     lex_end();
     /* XXX DAPM do this properly one year */
-    *padp = (AV*)SvREFCNT_inc_simple(PL_comppad);
+    *padp = MUTABLE_AV(SvREFCNT_inc_simple(PL_comppad));
     LEAVE;
     if (IN_PERL_COMPILETIME)
        CopHINTS_set(&PL_compiling, PL_hints);
@@ -2983,13 +2986,13 @@ S_doeval(pTHX_ int gimme, OP** startop, CV* outside, U32 seq)
     PUSHMARK(SP);
 
     SAVESPTR(PL_compcv);
-    PL_compcv = (CV*)newSV_type(SVt_PVCV);
+    PL_compcv = MUTABLE_CV(newSV_type(SVt_PVCV));
     CvEVAL_on(PL_compcv);
     assert(CxTYPE(&cxstack[cxstack_ix]) == CXt_EVAL);
     cxstack[cxstack_ix].blk_eval.cv = PL_compcv;
 
     CvOUTSIDE_SEQ(PL_compcv) = seq;
-    CvOUTSIDE(PL_compcv) = (CV*)SvREFCNT_inc_simple(outside);
+    CvOUTSIDE(PL_compcv) = MUTABLE_CV(SvREFCNT_inc_simple(outside));
 
     /* set up a scratch pad */
 
@@ -3100,9 +3103,9 @@ S_doeval(pTHX_ int gimme, OP** startop, CV* outside, U32 seq)
        if (cv) {
            dSP;
            PUSHMARK(SP);
-           XPUSHs((SV*)CopFILEGV(&PL_compiling));
+           XPUSHs(MUTABLE_SV(CopFILEGV(&PL_compiling)));
            PUTBACK;
-           call_sv((SV*)cv, G_DISCARD);
+           call_sv(MUTABLE_SV(cv), G_DISCARD);
        }
     }
 
@@ -3208,14 +3211,14 @@ PP(pp_require)
                I32 first = 0;
                AV *lav;
                SV * const req = SvRV(sv);
-               SV * const pv = *hv_fetchs((HV*)req, "original", FALSE);
+               SV * const pv = *hv_fetchs(MUTABLE_HV(req), "original", FALSE);
 
                /* get the left hand term */
-               lav = (AV *)SvRV(*hv_fetchs((HV*)req, "version", FALSE));
+               lav = MUTABLE_AV(SvRV(*hv_fetchs(MUTABLE_HV(req), "version", FALSE)));
 
                first  = SvIV(*av_fetch(lav,0,0));
                if (   first > (int)PERL_REVISION    /* probably 'use 6.0' */
-                   || hv_exists((HV*)req, "qv", 2 ) /* qv style */
+                   || hv_exists(MUTABLE_HV(req), "qv", 2 ) /* qv style */
                    || av_len(lav) > 1               /* FP with > 3 digits */
                    || strstr(SvPVX(pv),".0")        /* FP with leading 0 */
                   ) {
@@ -3324,7 +3327,7 @@ PP(pp_require)
            for (i = 0; i <= AvFILL(ar); i++) {
                SV * const dirsv = *av_fetch(ar, i, TRUE);
 
-               if (SvTIED_mg((SV*)ar, PERL_MAGIC_tied))
+               if (SvTIED_mg((const SV *)ar, PERL_MAGIC_tied))
                    mg_get(dirsv);
                if (SvROK(dirsv)) {
                    int count;
@@ -3334,7 +3337,7 @@ PP(pp_require)
                    if (SvTYPE(SvRV(loader)) == SVt_PVAV
                        && !sv_isobject(loader))
                    {
-                       loader = *av_fetch((AV *)SvRV(loader), 0, TRUE);
+                       loader = *av_fetch(MUTABLE_AV(SvRV(loader)), 0, TRUE);
                    }
 
                    Perl_sv_setpvf(aTHX_ namesv, "/loader/0x%"UVxf"/%s",
@@ -3383,7 +3386,7 @@ PP(pp_require)
                        }
 
                        if (isGV_with_GP(arg)) {
-                           IO * const io = GvIO((GV *)arg);
+                           IO * const io = GvIO((const GV *)arg);
 
                            ++filter_has_file;
 
@@ -3601,9 +3604,9 @@ PP(pp_require)
     if (filter_sub || filter_cache) {
        SV * const datasv = filter_add(S_run_user_filter, NULL);
        IoLINES(datasv) = filter_has_file;
-       IoTOP_GV(datasv) = (GV *)filter_state;
-       IoBOTTOM_GV(datasv) = (GV *)filter_sub;
-       IoFMT_GV(datasv) = (GV *)filter_cache;
+       IoTOP_GV(datasv) = MUTABLE_GV(filter_state);
+       IoBOTTOM_GV(datasv) = MUTABLE_GV(filter_sub);
+       IoFMT_GV(datasv) = MUTABLE_GV(filter_cache);
     }
 
     /* switch to eval mode */
@@ -3639,7 +3642,7 @@ PP(pp_hintseval)
 {
     dVAR;
     dSP;
-    mXPUSHs((SV*)Perl_hv_copy_hints_hv(aTHX_ (HV*)cSVOP_sv));
+    mXPUSHs(MUTABLE_SV(Perl_hv_copy_hints_hv(aTHX_ MUTABLE_HV(cSVOP_sv))));
     RETURN;
 }
 
@@ -3663,7 +3666,7 @@ PP(pp_entereval)
     const int fakelen = 9 + 1;
     
     if (PL_op->op_private & OPpEVAL_HAS_HH) {
-       saved_hh = (HV*) SvREFCNT_inc(POPs);
+       saved_hh = MUTABLE_HV(SvREFCNT_inc(POPs));
     }
     sv = POPs;
 
@@ -3725,11 +3728,12 @@ PP(pp_entereval)
 
     /* prepare to compile string */
 
-    if (PERLDB_LINE && PL_curstash != PL_debstash)
+    if (PERLDB_SAVESRC && PL_curstash != PL_debstash)
        save_lines(CopFILEAV(&PL_compiling), PL_parser->linestr);
     PUTBACK;
     ok = doeval(gimme, NULL, runcv, seq);
-    if (PERLDB_INTER && was != (I32)PL_sub_generation /* Some subs defined here. */
+    if ((PERLDB_LINE || PERLDB_SAVESRC)
+       && was != (I32)PL_sub_generation /* Some subs defined here. */
        && ok) {
        /* Copy in anything fake and short. */
        my_strlcpy(safestr, fakestr, fakelen);
@@ -4108,7 +4112,7 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other)
        if (SM_OTHER_REF(PVHV)) {
            /* Check that the key-sets are identical */
            HE *he;
-           HV *other_hv = (HV *) SvRV(Other);
+           HV *other_hv = MUTABLE_HV(SvRV(Other));
            bool tied = FALSE;
            bool other_tied = FALSE;
            U32 this_key_count  = 0,
@@ -4118,29 +4122,29 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other)
            if (SvTIED_mg(This, PERL_MAGIC_tied)) {
                tied = TRUE;
            }
-           else if (SvTIED_mg((SV *) other_hv, PERL_MAGIC_tied)) {
+           else if (SvTIED_mg((const SV *)other_hv, PERL_MAGIC_tied)) {
                HV * const temp = other_hv;
-               other_hv = (HV *) This;
-               This  = (SV *) temp;
+               other_hv = MUTABLE_HV(This);
+               This  = MUTABLE_SV(temp);
                tied = TRUE;
            }
-           if (SvTIED_mg((SV *) other_hv, PERL_MAGIC_tied))
+           if (SvTIED_mg((const SV *)other_hv, PERL_MAGIC_tied))
                other_tied = TRUE;
            
-           if (!tied && HvUSEDKEYS((HV *) This) != HvUSEDKEYS(other_hv))
+           if (!tied && HvUSEDKEYS((const HV *) This) != HvUSEDKEYS(other_hv))
                RETPUSHNO;
 
            /* The hashes have the same number of keys, so it suffices
               to check that one is a subset of the other. */
-           (void) hv_iterinit((HV *) This);
-           while ( (he = hv_iternext((HV *) This)) ) {
+           (void) hv_iterinit(MUTABLE_HV(This));
+           while ( (he = hv_iternext(MUTABLE_HV(This))) ) {
                I32 key_len;
                char * const key = hv_iterkey(he, &key_len);
                
                ++ this_key_count;
                
                if(!hv_exists(other_hv, key, key_len)) {
-                   (void) hv_iterinit((HV *) This);    /* reset iterator */
+                   (void) hv_iterinit(MUTABLE_HV(This));       /* reset iterator */
                    RETPUSHNO;
                }
            }
@@ -4159,7 +4163,7 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other)
                RETPUSHYES;
        }
        else if (SM_OTHER_REF(PVAV)) {
-           AV * const other_av = (AV *) SvRV(Other);
+           AV * const other_av = MUTABLE_AV(SvRV(Other));
            const I32 other_len = av_len(other_av) + 1;
            I32 i;
 
@@ -4170,7 +4174,7 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other)
 
                if (svp) {      /* ??? When can this not happen? */
                    key = SvPV(*svp, key_len);
-                   if (hv_exists((HV *) This, key, key_len))
+                   if (hv_exists(MUTABLE_HV(This), key, key_len))
                        RETPUSHYES;
                }
            }
@@ -4180,10 +4184,10 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other)
            PMOP * const matcher = make_matcher(other_regex);
            HE *he;
 
-           (void) hv_iterinit((HV *) This);
-           while ( (he = hv_iternext((HV *) This)) ) {
+           (void) hv_iterinit(MUTABLE_HV(This));
+           while ( (he = hv_iternext(MUTABLE_HV(This))) ) {
                if (matcher_matches_sv(matcher, hv_iterkeysv(he))) {
-                   (void) hv_iterinit((HV *) This);
+                   (void) hv_iterinit(MUTABLE_HV(This));
                    destroy_matcher(matcher);
                    RETPUSHYES;
                }
@@ -4192,7 +4196,7 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other)
            RETPUSHNO;
        }
        else {
-           if (hv_exists_ent((HV *) This, Other, 0))
+           if (hv_exists_ent(MUTABLE_HV(This), Other, 0))
                RETPUSHYES;
            else
                RETPUSHNO;
@@ -4200,8 +4204,8 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other)
     }
     else if (SM_REF(PVAV)) {
        if (SM_OTHER_REF(PVAV)) {
-           AV *other_av = (AV *) SvRV(Other);
-           if (av_len((AV *) This) != av_len(other_av))
+           AV *other_av = MUTABLE_AV(SvRV(Other));
+           if (av_len(MUTABLE_AV(This)) != av_len(other_av))
                RETPUSHNO;
            else {
                I32 i;
@@ -4209,14 +4213,14 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other)
 
                if (NULL == seen_this) {
                    seen_this = newHV();
-                   (void) sv_2mortal((SV *) seen_this);
+                   (void) sv_2mortal(MUTABLE_SV(seen_this));
                }
                if (NULL == seen_other) {
                    seen_this = newHV();
-                   (void) sv_2mortal((SV *) seen_other);
+                   (void) sv_2mortal(MUTABLE_SV(seen_other));
                }
                for(i = 0; i <= other_len; ++i) {
-                   SV * const * const this_elem = av_fetch((AV *)This, i, FALSE);
+                   SV * const * const this_elem = av_fetch(MUTABLE_AV(This), i, FALSE);
                    SV * const * const other_elem = av_fetch(other_av, i, FALSE);
 
                    if (!this_elem || !other_elem) {
@@ -4252,11 +4256,11 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other)
        }
        else if (SM_OTHER_REGEX) {
            PMOP * const matcher = make_matcher(other_regex);
-           const I32 this_len = av_len((AV *) This);
+           const I32 this_len = av_len(MUTABLE_AV(This));
            I32 i;
 
            for(i = 0; i <= this_len; ++i) {
-               SV * const * const svp = av_fetch((AV *)This, i, FALSE);
+               SV * const * const svp = av_fetch(MUTABLE_AV(This), i, FALSE);
                if (svp && matcher_matches_sv(matcher, *svp)) {
                    destroy_matcher(matcher);
                    RETPUSHYES;
@@ -4268,8 +4272,8 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other)
        else if (SvIOK(Other) || SvNOK(Other)) {
            I32 i;
 
-           for(i = 0; i <= AvFILL((AV *) This); ++i) {
-               SV * const * const svp = av_fetch((AV *)This, i, FALSE);
+           for(i = 0; i <= AvFILL(MUTABLE_AV(This)); ++i) {
+               SV * const * const svp = av_fetch(MUTABLE_AV(This), i, FALSE);
                if (!svp)
                    continue;
                
@@ -4287,11 +4291,11 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other)
            RETPUSHNO;
        }
        else if (SvPOK(Other)) {
-           const I32 this_len = av_len((AV *) This);
+           const I32 this_len = av_len(MUTABLE_AV(This));
            I32 i;
 
            for(i = 0; i <= this_len; ++i) {
-               SV * const * const svp = av_fetch((AV *)This, i, FALSE);
+               SV * const * const svp = av_fetch(MUTABLE_AV(This), i, FALSE);
                if (!svp)
                    continue;
                
@@ -4738,8 +4742,8 @@ S_run_user_filter(pTHX_ int idx, SV *buf_sv, int maxlen)
     dVAR;
     SV * const datasv = FILTER_DATA(idx);
     const int filter_has_file = IoLINES(datasv);
-    SV * const filter_state = (SV *)IoTOP_GV(datasv);
-    SV * const filter_sub = (SV *)IoBOTTOM_GV(datasv);
+    SV * const filter_state = MUTABLE_SV(IoTOP_GV(datasv));
+    SV * const filter_sub = MUTABLE_SV(IoBOTTOM_GV(datasv));
     int status = 0;
     SV *upstream;
     STRLEN got_len;
@@ -4759,7 +4763,7 @@ S_run_user_filter(pTHX_ int idx, SV *buf_sv, int maxlen)
        not sure where the trouble is yet.  XXX */
 
     if (IoFMT_GV(datasv)) {
-       SV *const cache = (SV *)IoFMT_GV(datasv);
+       SV *const cache = MUTABLE_SV(IoFMT_GV(datasv));
        if (SvOK(cache)) {
            STRLEN cache_len;
            const char *cache_p = SvPV(cache, cache_len);
@@ -4818,7 +4822,7 @@ S_run_user_filter(pTHX_ int idx, SV *buf_sv, int maxlen)
        SAVETMPS;
        EXTEND(SP, 2);
 
-       DEFSV = upstream;
+       DEFSV_set(upstream);
        PUSHMARK(SP);
        mPUSHi(0);
        if (filter_state) {
@@ -4858,10 +4862,10 @@ S_run_user_filter(pTHX_ int idx, SV *buf_sv, int maxlen)
     if (prune_from) {
        /* Oh. Too long. Stuff some in our cache.  */
        STRLEN cached_len = got_p + got_len - prune_from;
-       SV *cache = (SV *)IoFMT_GV(datasv);
+       SV *cache = MUTABLE_SV(IoFMT_GV(datasv));
 
        if (!cache) {
-           IoFMT_GV(datasv) = (GV*) (cache = newSV(got_len - umaxlen));
+           IoFMT_GV(datasv) = MUTABLE_GV((cache = newSV(got_len - umaxlen)));
        } else if (SvOK(cache)) {
            /* Cache should be empty.  */
            assert(!SvCUR(cache));