This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
perlapi: Clarify entry for utf8n_to_uvchr()
[perl5.git] / mro_core.c
index 25d30d9..d1abc28 100644 (file)
@@ -191,6 +191,10 @@ Perl_mro_meta_dup(pTHX_ struct mro_meta* smeta, CLONE_PARAMS* param)
 
     newmeta->super = NULL;
 
+    /* clear the destructor cache */
+    newmeta->destroy = NULL;
+    newmeta->destroy_gen = 0;
+
     return newmeta;
 }
 
@@ -199,7 +203,7 @@ Perl_mro_meta_dup(pTHX_ struct mro_meta* smeta, CLONE_PARAMS* param)
 /*
 =for apidoc mro_get_linear_isa_dfs
 
-Returns the Depth-First Search linearization of @ISA
+Returns the Depth-First Search linearization of C<@ISA>
 the given stash.  The return value is a read-only AV*.
 C<level> should be 0 (it is used internally in this
 function's recursion).
@@ -237,7 +241,7 @@ S_mro_get_linear_isa_dfs(pTHX_ HV *stash, U32 level)
 
     if (level > 100)
         Perl_croak(aTHX_
-                 "Recursive inheritance detected in package '%"HEKf"'",
+                 "Recursive inheritance detected in package '%" HEKf "'",
                   HEKfARG(stashhek));
 
     meta = HvMROMETA(stash);
@@ -342,7 +346,7 @@ S_mro_get_linear_isa_dfs(pTHX_ HV *stash, U32 level)
                    /* They have no stash.  So create ourselves an ->isa cache
                       as if we'd copied it from what theirs should be.  */
                    stored = MUTABLE_HV(sv_2mortal(MUTABLE_SV(newHV())));
-                   (void) hv_store(stored, "UNIVERSAL", 9, &PL_sv_undef, 0);
+                   (void) hv_stores(stored, "UNIVERSAL", &PL_sv_undef);
                    av_push(retval,
                            newSVhek(HeKEY_hek(hv_store_ent(stored, sv,
                                                            &PL_sv_undef, 0))));
@@ -352,7 +356,7 @@ S_mro_get_linear_isa_dfs(pTHX_ HV *stash, U32 level)
     } else {
        /* We have no parents.  */
        stored = MUTABLE_HV(sv_2mortal(MUTABLE_SV(newHV())));
-       (void) hv_store(stored, "UNIVERSAL", 9, &PL_sv_undef, 0);
+       (void) hv_stores(stored, "UNIVERSAL", &PL_sv_undef);
     }
 
     (void) hv_store_ent(stored, our_name, &PL_sv_undef, 0);
@@ -447,7 +451,7 @@ Perl_mro_get_linear_isa(pTHX_ HV *stash)
                             HEK_LEN(canon_name), HEK_FLAGS(canon_name),
                             HV_FETCH_ISSTORE, &PL_sv_undef,
                             HEK_HASH(canon_name));
-           (void) hv_store(isa_hash, "UNIVERSAL", 9, &PL_sv_undef, 0);
+           (void) hv_stores(isa_hash, "UNIVERSAL", &PL_sv_undef);
 
            SvREADONLY_on(isa_hash);
 
@@ -461,7 +465,7 @@ Perl_mro_get_linear_isa(pTHX_ HV *stash)
 =for apidoc mro_isa_changed_in
 
 Takes the necessary steps (cache invalidations, mostly)
-when the @ISA of the given package has changed.  Invoked
+when the C<@ISA> of the given package has changed.  Invoked
 by the C<setisa> magic, should not need to invoke directly.
 
 =cut
@@ -520,8 +524,8 @@ Perl_mro_isa_changed_in(pTHX_ HV* stash)
     svp = hv_fetchhek(PL_isarev, stashhek, 0);
     isarev = svp ? MUTABLE_HV(*svp) : NULL;
 
-    if((stashname_len == 9 && strEQ(stashname, "UNIVERSAL"))
-        || (isarev && hv_exists(isarev, "UNIVERSAL", 9))) {
+    if((memEQs(stashname, stashname_len, "UNIVERSAL"))
+        || (isarev && hv_existss(isarev, "UNIVERSAL"))) {
         PL_sub_generation++;
         is_universal = TRUE;
     }
@@ -538,8 +542,8 @@ Perl_mro_isa_changed_in(pTHX_ HV* stash)
     /* pessimise derefs for now. Will get recalculated by Gv_AMupdate() */
     HvAUX(stash)->xhv_aux_flags &= ~HvAUXf_NO_DEREF;
 
-    /* DESTROY can be cached in SvSTASH. */
-    if (!SvOBJECT(stash)) SvSTASH(stash) = NULL;
+    /* DESTROY can be cached in meta. */
+    meta->destroy_gen = 0;
 
     /* Iterate the isarev (classes that are our children),
        wiping out their linearization, method and isa caches
@@ -950,7 +954,7 @@ S_mro_gather_and_rename(pTHX_ HV * const stashes, HV * const seen_stashes,
                STRLEN len;
                const char *name = SvPVx_const(*svp, len);
                if(PL_stashcache) {
-                    DEBUG_o(Perl_deb(aTHX_ "mro_gather_and_rename clearing PL_stashcache for '%"SVf"'\n",
+                    DEBUG_o(Perl_deb(aTHX_ "mro_gather_and_rename clearing PL_stashcache for '%" SVf "'\n",
                                      SVfARG(*svp)));
                   (void)hv_delete(PL_stashcache, name, name_utf8 ? -(I32)len : (I32)len, G_DISCARD);
                 }
@@ -1295,7 +1299,7 @@ XS code.
 
 2) Assigning a reference to a readonly scalar
 constant into a stash entry in order to create
-a constant subroutine (like constant.pm
+a constant subroutine (like F<constant.pm>
 does).
 
 This same method is available from pure perl
@@ -1320,13 +1324,13 @@ Perl_mro_method_changed_in(pTHX_ HV *stash)
     /* Inc the package generation, since a local method changed */
     HvMROMETA(stash)->pkg_gen++;
 
-    /* DESTROY can be cached in SvSTASH. */
-    if (!SvOBJECT(stash)) SvSTASH(stash) = NULL;
+    /* DESTROY can be cached in meta */
+    HvMROMETA(stash)->destroy_gen = 0;
 
     /* If stash is UNIVERSAL, or one of UNIVERSAL's parents,
        invalidate all method caches globally */
-    if((stashname_len == 9 && strEQ(stashname, "UNIVERSAL"))
-        || (isarev && hv_exists(isarev, "UNIVERSAL", 9))) {
+    if((memEQs(stashname, stashname_len, "UNIVERSAL"))
+        || (isarev && hv_existss(isarev, "UNIVERSAL"))) {
         PL_sub_generation++;
         return;
     }
@@ -1346,7 +1350,7 @@ Perl_mro_method_changed_in(pTHX_ HV *stash)
             mrometa->cache_gen++;
             if(mrometa->mro_nextmethod)
                 hv_clear(mrometa->mro_nextmethod);
-            if (!SvOBJECT(revstash)) SvSTASH(revstash) = NULL;
+            mrometa->destroy_gen = 0;
         }
     }
 
@@ -1365,7 +1369,7 @@ Perl_mro_set_mro(pTHX_ struct mro_meta *const meta, SV *const name)
     PERL_ARGS_ASSERT_MRO_SET_MRO;
 
     if (!which)
-        Perl_croak(aTHX_ "Invalid mro name: '%"SVf"'", name);
+        Perl_croak(aTHX_ "Invalid mro name: '%" SVf "'", name);
 
     if(meta->mro_which != which) {
        if (meta->mro_linear_current && !meta->mro_linear_all) {
@@ -1411,7 +1415,7 @@ XS(XS_mro_method_changed_in)
     classname = ST(0);
 
     class_stash = gv_stashsv(classname, 0);
-    if(!class_stash) Perl_croak(aTHX_ "No such class: '%"SVf"'!", SVfARG(classname));
+    if(!class_stash) Perl_croak(aTHX_ "No such class: '%" SVf "'!", SVfARG(classname));
 
     mro_method_changed_in(class_stash);