This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Lies, damn lies and end-of-block comments
[perl5.git] / mro.c
diff --git a/mro.c b/mro.c
index f2cbee3..36ad3ba 100644 (file)
--- a/mro.c
+++ b/mro.c
@@ -1,6 +1,7 @@
 /*    mro.c
  *
  *    Copyright (c) 2007 Brandon L Black
+ *    Copyright (c) 2007, 2008 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.
@@ -8,8 +9,10 @@
  */
 
 /*
- * "Which order shall we go in?" said Frodo. "Eldest first, or quickest first?
- *  You'll be last either way, Master Peregrin."
+ * 'Which order shall we go in?' said Frodo.  'Eldest first, or quickest first?
+ *  You'll be last either way, Master Peregrin.'
+ *
+ *     [p.101 of _The Lord of the Rings_, I/iii: "A Conspiracy Unmasked"]
  */
 
 /*
@@ -26,7 +29,7 @@ These functions are related to the method resolution order of perl classes
 
 struct mro_alg {
     const char *name;
-    AV *(*resolve)(pTHX_ HV* stash, I32 level);
+    AV *(*resolve)(pTHX_ HV* stash, U32 level);
 };
 
 /* First one is the default */
@@ -81,16 +84,16 @@ Perl_mro_meta_dup(pTHX_ struct mro_meta* smeta, CLONE_PARAMS* param)
 
     if (newmeta->mro_linear_dfs)
        newmeta->mro_linear_dfs
-           = (AV*) SvREFCNT_inc(sv_dup((SV*)newmeta->mro_linear_dfs, param));
+           = MUTABLE_AV(SvREFCNT_inc(sv_dup((const SV *)newmeta->mro_linear_dfs, param)));
     if (newmeta->mro_linear_c3)
        newmeta->mro_linear_c3
-           = (AV*) SvREFCNT_inc(sv_dup((SV*)newmeta->mro_linear_c3, param));
+           = MUTABLE_AV(SvREFCNT_inc(sv_dup((const SV *)newmeta->mro_linear_c3, param)));
     if (newmeta->mro_nextmethod)
        newmeta->mro_nextmethod
-           = (HV*) SvREFCNT_inc(sv_dup((SV*)newmeta->mro_nextmethod, param));
+           = MUTABLE_HV(SvREFCNT_inc(sv_dup((const SV *)newmeta->mro_nextmethod, param)));
     if (newmeta->isa)
        newmeta->isa
-           = (HV*) SvREFCNT_inc(sv_dup((SV*)newmeta->isa, param));
+           = MUTABLE_HV(SvREFCNT_inc(sv_dup((const SV *)newmeta->isa, param)));
 
     return newmeta;
 }
@@ -149,7 +152,7 @@ invalidated).
 =cut
 */
 static AV*
-S_mro_get_linear_isa_dfs(pTHX_ HV *stash, I32 level)
+S_mro_get_linear_isa_dfs(pTHX_ HV *stash, U32 level)
 {
     AV* retval;
     GV** gvp;
@@ -180,7 +183,7 @@ S_mro_get_linear_isa_dfs(pTHX_ HV *stash, I32 level)
 
     /* not in cache, make a new one */
 
-    retval = (AV*)sv_2mortal((SV *)newAV());
+    retval = MUTABLE_AV(sv_2mortal(MUTABLE_SV(newAV())));
     /* We use this later in this function, but don't need a reference to it
        beyond the end of this function, so reference count is fine.  */
     our_name = newSVhek(stashhek);
@@ -196,7 +199,7 @@ S_mro_get_linear_isa_dfs(pTHX_ HV *stash, I32 level)
        It's then retained to be re-used as a fast lookup for ->isa(), by adding
        our own name and "UNIVERSAL" to it.  */
 
-    stored = (HV*)sv_2mortal((SV*)newHV());
+    stored = MUTABLE_HV(sv_2mortal(MUTABLE_SV(newHV())));
 
     if(av && AvFILLp(av) >= 0) {
 
@@ -302,7 +305,7 @@ invalidated).
 */
 
 static AV*
-S_mro_get_linear_isa_c3(pTHX_ HV* stash, I32 level)
+S_mro_get_linear_isa_c3(pTHX_ HV* stash, U32 level)
 {
     AV* retval;
     GV** gvp;
@@ -343,8 +346,8 @@ S_mro_get_linear_isa_c3(pTHX_ HV* stash, I32 level)
     if(isa && AvFILLp(isa) >= 0) {
         SV** seqs_ptr;
         I32 seqs_items;
-        HV* const tails = (HV*)sv_2mortal((SV*)newHV());
-        AV* const seqs = (AV*)sv_2mortal((SV*)newAV());
+        HV* const tails = MUTABLE_HV(sv_2mortal(MUTABLE_SV(newHV())));
+        AV *const seqs = MUTABLE_AV(sv_2mortal(MUTABLE_SV(newAV())));
         I32* heads;
 
         /* This builds @seqs, which is an array of arrays.
@@ -361,15 +364,15 @@ S_mro_get_linear_isa_c3(pTHX_ HV* stash, I32 level)
                    containing just itself */
                 AV* const isa_lin = newAV();
                 av_push(isa_lin, newSVsv(isa_item));
-                av_push(seqs, (SV*)isa_lin);
+                av_push(seqs, MUTABLE_SV(isa_lin));
             }
             else {
                 /* recursion */
                 AV* const isa_lin = mro_get_linear_isa_c3(isa_item_stash, level + 1);
-                av_push(seqs, SvREFCNT_inc_simple_NN((SV*)isa_lin));
+                av_push(seqs, SvREFCNT_inc_simple_NN(MUTABLE_SV(isa_lin)));
             }
         }
-        av_push(seqs, SvREFCNT_inc_simple_NN((SV*)isa));
+        av_push(seqs, SvREFCNT_inc_simple_NN(MUTABLE_SV(isa)));
 
         /* This builds "heads", which as an array of integer array
            indices, one per seq, which point at the virtual "head"
@@ -384,7 +387,7 @@ S_mro_get_linear_isa_c3(pTHX_ HV* stash, I32 level)
         seqs_ptr = AvARRAY(seqs);
         seqs_items = AvFILLp(seqs) + 1;
         while(seqs_items--) {
-            AV* const seq = (AV*)*seqs_ptr++;
+            AV *const seq = MUTABLE_AV(*seqs_ptr++);
             I32 seq_items = AvFILLp(seq);
             if(seq_items > 0) {
                 SV** seq_ptr = AvARRAY(seq) + 1;
@@ -418,7 +421,7 @@ S_mro_get_linear_isa_c3(pTHX_ HV* stash, I32 level)
             SV** const avptr = AvARRAY(seqs);
             for(s = 0; s <= AvFILLp(seqs); s++) {
                 SV** svp;
-                AV * const seq = (AV*)(avptr[s]);
+                AV * const seq = MUTABLE_AV(avptr[s]);
                SV* seqhead;
                 if(!seq) continue; /* skip empty seqs */
                 svp = av_fetch(seq, heads[s], 0);
@@ -565,8 +568,8 @@ Perl_mro_isa_changed_in(pTHX_ HV* stash)
 
     /* wipe out the cached linearizations for this stash */
     meta = HvMROMETA(stash);
-    SvREFCNT_dec((SV*)meta->mro_linear_dfs);
-    SvREFCNT_dec((SV*)meta->mro_linear_c3);
+    SvREFCNT_dec(MUTABLE_SV(meta->mro_linear_dfs));
+    SvREFCNT_dec(MUTABLE_SV(meta->mro_linear_c3));
     meta->mro_linear_dfs = NULL;
     meta->mro_linear_c3 = NULL;
     if (meta->isa) {
@@ -581,7 +584,7 @@ Perl_mro_isa_changed_in(pTHX_ HV* stash)
        is UNIVERSAL or one of its parents */
 
     svp = hv_fetch(PL_isarev, stashname, stashname_len, 0);
-    isarev = svp ? (HV*)*svp : NULL;
+    isarev = svp ? MUTABLE_HV(*svp) : NULL;
 
     if((stashname_len == 9 && strEQ(stashname, "UNIVERSAL"))
         || (isarev && hv_exists(isarev, "UNIVERSAL", 9))) {
@@ -608,8 +611,8 @@ Perl_mro_isa_changed_in(pTHX_ HV* stash)
 
             if(!revstash) continue;
             revmeta = HvMROMETA(revstash);
-            SvREFCNT_dec((SV*)revmeta->mro_linear_dfs);
-            SvREFCNT_dec((SV*)revmeta->mro_linear_c3);
+            SvREFCNT_dec(MUTABLE_SV(revmeta->mro_linear_dfs));
+            SvREFCNT_dec(MUTABLE_SV(revmeta->mro_linear_c3));
             revmeta->mro_linear_dfs = NULL;
             revmeta->mro_linear_c3 = NULL;
             if(!is_universal)
@@ -640,9 +643,9 @@ Perl_mro_isa_changed_in(pTHX_ HV* stash)
           us, then will need to upgrade it to an HV (which sv_upgrade() can
           now do for us. */
 
-        mroisarev = (HV*)HeVAL(he);
+        mroisarev = MUTABLE_HV(HeVAL(he));
 
-       SvUPGRADE((SV*)mroisarev, SVt_PVHV);
+       SvUPGRADE(MUTABLE_SV(mroisarev), SVt_PVHV);
 
        /* This hash only ever contains PL_sv_yes. Storing it over itself is
           almost as cheap as calling hv_exists, so on aggregate we expect to
@@ -699,7 +702,7 @@ Perl_mro_method_changed_in(pTHX_ HV *stash)
     const STRLEN stashname_len = HvNAMELEN_get(stash);
 
     SV ** const svp = hv_fetch(PL_isarev, stashname, stashname_len, 0);
-    HV * const isarev = svp ? (HV*)*svp : NULL;
+    HV * const isarev = svp ? MUTABLE_HV(*svp) : NULL;
 
     PERL_ARGS_ASSERT_MRO_METHOD_CHANGED_IN;
 
@@ -798,7 +801,7 @@ XS(XS_mro_get_linear_isa) {
         /* No stash exists yet, give them just the classname */
         AV* isalin = newAV();
         av_push(isalin, newSVsv(classname));
-        ST(0) = sv_2mortal(newRV_noinc((SV*)isalin));
+        ST(0) = sv_2mortal(newRV_noinc(MUTABLE_SV(isalin)));
         XSRETURN(1);
     }
     else if(items > 1) {
@@ -812,7 +815,7 @@ XS(XS_mro_get_linear_isa) {
         RETVAL = mro_get_linear_isa(class_stash);
     }
 
-    ST(0) = newRV_inc((SV*)RETVAL);
+    ST(0) = newRV_inc(MUTABLE_SV(RETVAL));
     sv_2mortal(ST(0));
     XSRETURN(1);
 }
@@ -890,7 +893,7 @@ XS(XS_mro_get_isarev)
 
     
     he = hv_fetch_ent(PL_isarev, classname, 0, 0);
-    isarev = he ? (HV*)HeVAL(he) : NULL;
+    isarev = he ? MUTABLE_HV(HeVAL(he)) : NULL;
 
     ret_array = newAV();
     if(isarev) {
@@ -899,7 +902,7 @@ XS(XS_mro_get_isarev)
         while((iter = hv_iternext(isarev)))
             av_push(ret_array, newSVsv(hv_iterkeysv(iter)));
     }
-    mXPUSHs(newRV_noinc((SV*)ret_array));
+    mXPUSHs(newRV_noinc(MUTABLE_SV(ret_array)));
 
     PUTBACK;
     return;
@@ -923,7 +926,7 @@ XS(XS_mro_is_universal)
     classname_pv = SvPV(classname,classname_len);
 
     he = hv_fetch_ent(PL_isarev, classname, 0, 0);
-    isarev = he ? (HV*)HeVAL(he) : NULL;
+    isarev = he ? MUTABLE_HV(HeVAL(he)) : NULL;
 
     if((classname_len == 9 && strEQ(classname_pv, "UNIVERSAL"))
         || (isarev && hv_exists(isarev, "UNIVERSAL", 9)))
@@ -1167,9 +1170,9 @@ XS(XS_mro_nextcan)
                entries, because in C3 the method cache of a parent is not
                valid for the child */
             if (SvTYPE(candidate) == SVt_PVGV && (cand_cv = GvCV(candidate)) && !GvCVGEN(candidate)) {
-                SvREFCNT_inc_simple_void_NN((SV*)cand_cv);
-                (void)hv_store_ent(nmcache, newSVsv(sv), (SV*)cand_cv, 0);
-                mXPUSHs(newRV_inc((SV*)cand_cv));
+                SvREFCNT_inc_simple_void_NN(MUTABLE_SV(cand_cv));
+                (void)hv_store_ent(nmcache, newSVsv(sv), MUTABLE_SV(cand_cv), 0);
+                mXPUSHs(newRV_inc(MUTABLE_SV(cand_cv)));
                 XSRETURN(1);
             }
         }