{
struct mro_meta* newmeta;
- assert(stash);
+ PERL_ARGS_ASSERT_MRO_META_INIT;
assert(HvAUX(stash));
assert(!(HvAUX(stash)->xhv_mro_meta));
Newxz(newmeta, 1, struct mro_meta);
{
struct mro_meta* newmeta;
- assert(smeta);
+ PERL_ARGS_ASSERT_MRO_META_DUP;
Newx(newmeta, 1, struct mro_meta);
Copy(smeta, newmeta, 1, struct mro_meta);
const HEK* stashhek;
struct mro_meta* meta;
- assert(stash);
+ PERL_ARGS_ASSERT_MRO_GET_LINEAR_ISA_DFS;
assert(HvAUX(stash));
stashhek = HvNAME_HEK(stash);
}
while(subrv_items--) {
SV *const subsv = *subrv_p++;
- if(!hv_exists_ent(stored, subsv, 0)) {
- (void)hv_store_ent(stored, subsv, &PL_sv_undef, 0);
- av_push(retval, newSVsv(subsv));
+ /* LVALUE fetch will create a new undefined SV if necessary
+ */
+ HE *const he = hv_fetch_ent(stored, subsv, 1, 0);
+ assert(he);
+ if(HeVAL(he) != &PL_sv_undef) {
+ /* It was newly created. Steal it for our new SV, and
+ replace it in the hash with the "real" thing. */
+ SV *const val = HeVAL(he);
+ HEK *const key = HeKEY_hek(he);
+
+ HeVAL(he) = &PL_sv_undef;
+ /* Save copying by making a shared hash key scalar. We
+ inline this here rather than calling Perl_newSVpvn_share
+ because we already have the scalar, and we already have
+ the hash key. */
+ assert(SvTYPE(val) == SVt_NULL);
+ sv_upgrade(val, SVt_PV);
+ SvPV_set(val, HEK_KEY(share_hek_hek(key)));
+ SvCUR_set(val, HEK_LEN(key));
+ SvREADONLY_on(val);
+ SvFAKE_on(val);
+ SvPOK_on(val);
+ if (HEK_UTF8(key))
+ SvUTF8_on(val);
+
+ av_push(retval, val);
}
}
}
const HEK* stashhek;
struct mro_meta* meta;
- assert(stash);
+ PERL_ARGS_ASSERT_MRO_GET_LINEAR_ISA_C3;
assert(HvAUX(stash));
stashhek = HvNAME_HEK(stash);
{
struct mro_meta* meta;
- assert(stash);
+ PERL_ARGS_ASSERT_MRO_GET_LINEAR_ISA;
if(!SvOOK(stash))
Perl_croak(aTHX_ "Can't linearize anonymous symbol table");
const char * const stashname = HvNAME_get(stash);
const STRLEN stashname_len = HvNAMELEN_get(stash);
+ PERL_ARGS_ASSERT_MRO_ISA_CHANGED_IN;
+
if(!stashname)
Perl_croak(aTHX_ "Can't call mro_isa_changed_in() on anonymous symbol table");
SV ** const svp = hv_fetch(PL_isarev, stashname, stashname_len, 0);
HV * const isarev = svp ? (HV*)*svp : NULL;
+ PERL_ARGS_ASSERT_MRO_METHOD_CHANGED_IN;
+
if(!stashname)
Perl_croak(aTHX_ "Can't call mro_method_changed_in() on anonymous symbol table");
HV* class_stash;
SV* classname;
- PERL_UNUSED_ARG(cv);
-
if(items < 1 || items > 2)
- Perl_croak(aTHX_ "Usage: mro::get_linear_isa(classname [, type ])");
+ croak_xs_usage(cv, "classname [, type ]");
classname = ST(0);
class_stash = gv_stashsv(classname, 0);
HV* class_stash;
struct mro_meta* meta;
- PERL_UNUSED_ARG(cv);
-
if (items != 2)
- Perl_croak(aTHX_ "Usage: mro::set_mro(classname, type)");
+ croak_xs_usage(cv, "classname, type");
classname = ST(0);
whichstr = SvPV_nolen(ST(1));
SV* classname;
HV* class_stash;
- PERL_UNUSED_ARG(cv);
-
if (items != 1)
- Perl_croak(aTHX_ "Usage: mro::get_mro(classname)");
+ croak_xs_usage(cv, "classname");
classname = ST(0);
class_stash = gv_stashsv(classname, 0);
HV* isarev;
AV* ret_array;
- PERL_UNUSED_ARG(cv);
-
if (items != 1)
- Perl_croak(aTHX_ "Usage: mro::get_isarev(classname)");
+ croak_xs_usage(cv, "classname");
classname = ST(0);
STRLEN classname_len;
HE* he;
- PERL_UNUSED_ARG(cv);
-
if (items != 1)
- Perl_croak(aTHX_ "Usage: mro::is_universal(classname)");
+ croak_xs_usage(cv, "classname");
classname = ST(0);
dVAR;
dXSARGS;
- PERL_UNUSED_ARG(cv);
-
if (items != 0)
- Perl_croak(aTHX_ "Usage: mro::invalidate_all_method_caches()");
+ croak_xs_usage(cv, "");
PL_sub_generation++;
SV* classname;
HV* class_stash;
- PERL_UNUSED_ARG(cv);
-
if(items != 1)
- Perl_croak(aTHX_ "Usage: mro::method_changed_in(classname)");
+ croak_xs_usage(cv, "classname");
classname = ST(0);
SV* classname;
HV* class_stash;
- PERL_UNUSED_ARG(cv);
-
if(items != 1)
- Perl_croak(aTHX_ "Usage: mro::get_pkg_gen(classname)");
+ croak_xs_usage(cv, "classname");
classname = ST(0);
if(sv_isobject(self))
selfstash = SvSTASH(SvRV(self));
else
- selfstash = gv_stashsv(self, 0);
+ selfstash = gv_stashsv(self, GV_ADD);
assert(selfstash);