This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Add MUTABLE_CV(), and eliminate (CV *) casts in *.c.
[perl5.git] / pp.c
diff --git a/pp.c b/pp.c
index 3551d8f..38ba12e 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -1,7 +1,7 @@
 /*    pp.c
  *
- *    Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
- *    2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007 by Larry Wall and others
+ *    Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000,
+ *    2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008 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.
@@ -119,7 +119,7 @@ PP(pp_padhv)
        RETURNOP(do_kv());
     }
     else if (gimme == G_SCALAR) {
-       SV* const sv = Perl_hv_scalar(aTHX_ (HV*)TARG);
+       SV* const sv = Perl_hv_scalar(aTHX_ MUTABLE_HV(TARG));
        SETs(sv);
     }
     RETURN;
@@ -143,11 +143,11 @@ PP(pp_rv2gv)
            SvREFCNT_inc_void_NN(sv);
            sv = (SV*) gv;
        }
-       else if (SvTYPE(sv) != SVt_PVGV)
+       else if (!isGV_with_GP(sv))
            DIE(aTHX_ "Not a GLOB reference");
     }
     else {
-       if (SvTYPE(sv) != SVt_PVGV) {
+       if (!isGV_with_GP(sv)) {
            if (SvGMAGICAL(sv)) {
                mg_get(sv);
                if (SvROK(sv))
@@ -285,7 +285,7 @@ PP(pp_rv2sv)
     else {
        gv = (GV*)sv;
 
-       if (SvTYPE(gv) != SVt_PVGV) {
+       if (!isGV_with_GP(gv)) {
            if (SvGMAGICAL(sv)) {
                mg_get(sv);
                if (SvROK(sv))
@@ -376,7 +376,7 @@ PP(pp_rv2cv)
     CV *cv = sv_2cv(TOPs, &stash_unused, &gv, flags);
     if (cv) {
        if (CvCLONE(cv))
-           cv = (CV*)sv_2mortal((SV*)cv_clone(cv));
+           cv = MUTABLE_CV(sv_2mortal((SV*)cv_clone(cv)));
        if ((PL_op->op_private & OPpLVAL_INTRO)) {
            if (gv && GvCV(gv) == cv && (gv = gv_autoload4(GvSTASH(gv), GvNAME(gv), GvNAMELEN(gv), FALSE)))
                cv = GvCV(gv);
@@ -385,10 +385,10 @@ PP(pp_rv2cv)
        }
     }
     else if ((flags == (GV_ADD|GV_NOEXPAND)) && gv && SvROK(gv)) {
-       cv = (CV*)gv;
+       cv = MUTABLE_CV(gv);
     }    
     else
-       cv = (CV*)&PL_sv_undef;
+       cv = MUTABLE_CV(&PL_sv_undef);
     SETs((SV*)cv);
     RETURN;
 }
@@ -472,9 +472,9 @@ PP(pp_prototype)
 PP(pp_anoncode)
 {
     dVAR; dSP;
-    CV* cv = (CV*)PAD_SV(PL_op->op_targ);
+    CV *cv = MUTABLE_CV(PAD_SV(PL_op->op_targ));
     if (CvCLONE(cv))
-       cv = (CV*)sv_2mortal((SV*)cv_clone(cv));
+       cv = MUTABLE_CV(sv_2mortal((SV*)cv_clone(cv)));
     EXTEND(SP,1);
     PUSHs((SV*)cv);
     RETURN;
@@ -806,25 +806,28 @@ PP(pp_undef)
        av_undef((AV*)sv);
        break;
     case SVt_PVHV:
-       hv_undef((HV*)sv);
+       hv_undef(MUTABLE_HV(sv));
        break;
     case SVt_PVCV:
-       if (cv_const_sv((CV*)sv) && ckWARN(WARN_MISC))
+       if (cv_const_sv((const CV *)sv) && ckWARN(WARN_MISC))
            Perl_warner(aTHX_ packWARN(WARN_MISC), "Constant subroutine %s undefined",
-                CvANON((CV*)sv) ? "(anonymous)" : GvENAME(CvGV((CV*)sv)));
+                CvANON((const CV *)sv) ? "(anonymous)"
+                       : GvENAME(CvGV((const CV *)sv)));
        /* FALLTHROUGH */
     case SVt_PVFM:
        {
            /* let user-undef'd sub keep its identity */
-           GV* const gv = CvGV((CV*)sv);
-           cv_undef((CV*)sv);
-           CvGV((CV*)sv) = gv;
+           GV* const gv = CvGV((const CV *)sv);
+           cv_undef(MUTABLE_CV(sv));
+           CvGV((const CV *)sv) = gv;
        }
        break;
     case SVt_PVGV:
-       if (SvFAKE(sv))
+       if (SvFAKE(sv)) {
            SvSetMagicSV(sv, &PL_sv_undef);
-       else {
+           break;
+       }
+       else if (isGV_with_GP(sv)) {
            GP *gp;
             HV *stash;
 
@@ -842,8 +845,9 @@ PP(pp_undef)
            GvLINE(sv) = CopLINE(PL_curcop);
            GvEGV(sv) = (GV*)sv;
            GvMULTI_on(sv);
+           break;
        }
-       break;
+       /* FALL THROUGH */
     default:
        if (SvTYPE(sv) >= SVt_PV && SvPVX_const(sv) && SvLEN(sv)) {
            SvPV_free(sv);
@@ -860,7 +864,7 @@ PP(pp_undef)
 PP(pp_predec)
 {
     dVAR; dSP;
-    if (SvTYPE(TOPs) >= SVt_PVGV && SvTYPE(TOPs) != SVt_PVLV)
+    if (SvTYPE(TOPs) >= SVt_PVAV || isGV_with_GP(TOPs))
        DIE(aTHX_ PL_no_modify);
     if (!SvREADONLY(TOPs) && SvIOK_notUV(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs)
         && SvIVX(TOPs) != IV_MIN)
@@ -877,7 +881,7 @@ PP(pp_predec)
 PP(pp_postinc)
 {
     dVAR; dSP; dTARGET;
-    if (SvTYPE(TOPs) >= SVt_PVGV && SvTYPE(TOPs) != SVt_PVLV)
+    if (SvTYPE(TOPs) >= SVt_PVAV || isGV_with_GP(TOPs))
        DIE(aTHX_ PL_no_modify);
     sv_setsv(TARG, TOPs);
     if (!SvREADONLY(TOPs) && SvIOK_notUV(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs)
@@ -899,7 +903,7 @@ PP(pp_postinc)
 PP(pp_postdec)
 {
     dVAR; dSP; dTARGET;
-    if (SvTYPE(TOPs) >= SVt_PVGV && SvTYPE(TOPs) != SVt_PVLV)
+    if (SvTYPE(TOPs) >= SVt_PVAV || isGV_with_GP(TOPs))
        DIE(aTHX_ PL_no_modify);
     sv_setsv(TARG, TOPs);
     if (!SvREADONLY(TOPs) && SvIOK_notUV(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs)
@@ -3180,7 +3184,7 @@ PP(pp_substr)
            }
            if (!SvOK(sv))
                sv_setpvs(sv, "");
-           sv_insert(sv, pos, rem, repl, repl_len);
+           sv_insert_flags(sv, pos, rem, repl, repl_len, 0);
            if (repl_is_utf8)
                SvUTF8_on(sv);
            if (repl_sv_copy)
@@ -3199,7 +3203,7 @@ PP(pp_substr)
                else if (SvOK(sv))      /* is it defined ? */
                    (void)SvPOK_only_UTF8(sv);
                else
-                   sv_setpvn(sv,"",0); /* avoid lexical reincarnation */
+                   sv_setpvs(sv, ""); /* avoid lexical reincarnation */
            }
 
            if (SvTYPE(TARG) < SVt_PVLV) {
@@ -4008,7 +4012,7 @@ PP(pp_each)
 {
     dVAR;
     dSP;
-    HV * hash = (HV*)POPs;
+    HV * hash = MUTABLE_HV(POPs);
     HE *entry;
     const I32 gimme = GIMME_V;
 
@@ -4045,7 +4049,7 @@ PP(pp_delete)
 
     if (PL_op->op_private & OPpSLICE) {
        dMARK; dORIGMARK;
-       HV * const hv = (HV*)POPs;
+       HV * const hv = MUTABLE_HV(POPs);
        const U32 hvtype = SvTYPE(hv);
        if (hvtype == SVt_PVHV) {                       /* hash element */
            while (++MARK <= SP) {
@@ -4076,7 +4080,7 @@ PP(pp_delete)
     }
     else {
        SV *keysv = POPs;
-       HV * const hv = (HV*)POPs;
+       HV * const hv = MUTABLE_HV(POPs);
        SV *sv;
        if (SvTYPE(hv) == SVt_PVHV)
            sv = hv_delete_ent(hv, keysv, discard, 0);
@@ -4114,7 +4118,7 @@ PP(pp_exists)
        RETPUSHNO;
     }
     tmpsv = POPs;
-    hv = (HV*)POPs;
+    hv = MUTABLE_HV(POPs);
     if (SvTYPE(hv) == SVt_PVHV) {
        if (hv_exists_ent(hv, tmpsv, 0))
            RETPUSHYES;
@@ -4134,7 +4138,7 @@ PP(pp_exists)
 PP(pp_hslice)
 {
     dVAR; dSP; dMARK; dORIGMARK;
-    register HV * const hv = (HV*)POPs;
+    register HV * const hv = MUTABLE_HV(POPs);
     register const I32 lval = (PL_op->op_flags & OPf_MOD || LVRET);
     const bool localizing = PL_op->op_private & OPpLVAL_INTRO;
     bool other_magic = FALSE;
@@ -4604,13 +4608,18 @@ PP(pp_reverse)
        SvUTF8_off(TARG);                               /* decontaminate */
        if (SP - MARK > 1)
            do_join(TARG, &PL_sv_no, MARK, SP);
-       else
+       else {
            sv_setsv(TARG, (SP > MARK)
                    ? *SP
                    : (padoff_du = find_rundefsvoffset(),
                        (padoff_du == NOT_IN_PAD
                         || PAD_COMPNAME_FLAGS_isOUR(padoff_du))
                        ? DEFSV : PAD_SVl(padoff_du)));
+
+           if (! SvOK(TARG) && ckWARN(WARN_UNINITIALIZED))
+               report_uninit(TARG);
+       }
+
        up = SvPV_force(TARG, len);
        if (len > 1) {
            if (DO_UTF8(TARG)) {        /* first reverse each character */