2 ----------------------------------------------------------------------------
4 Devel::MRO/mro_compat.h - Provides mro functions for XS modules
6 Copyright (c) 2008-2009, Goro Fuji (gfx) <gfuji(at)cpan.org>.
8 This program is free software; you can redistribute it and/or
9 modify it under the same terms as Perl itself.
11 ----------------------------------------------------------------------------
14 #include "mro_compat.h"
17 AV* mro_get_linear_isa(HV* stash)
18 UV mro_get_pkg_gen(HV* stash)
19 void mro_method_changed_in(HV* stash)
22 See "perldoc Devel::MRO" for details.
26 #ifdef mro_get_linear_isa /* >= 5.10.0 */
29 Because ActivePerl 5.10.0 does not provide Perl_mro_meta_init(),
30 which is used in HvMROMETA() macro, this mro_get_pkg_gen() refers
31 to xhv_mro_meta directly.
33 /* compatible with &mro::get_pkg_gen() */
34 #ifndef mro_get_pkg_gen
35 #define mro_get_pkg_gen(stash) (HvAUX(stash) ? HvAUX(stash)->xhv_mro_meta->pkg_gen : (U32)0)
38 #ifndef mro_get_cache_gen
39 #define mro_get_cache_gen(stash) (HvAUX(stash) ? HvAUX(stash)->xhv_mro_meta->cache_gen : (U32)0)
43 #define mro_get_gen(stash) (HvAUX(stash) ? (HvAUX(stash)->xhv_mro_meta->pkg_gen + HvAUX(stash)->xhv_mro_meta->cache_gen) : (U32)0)
47 #define mro_get_linear_isa(stash) my_mro_get_linear_isa(aTHX_ stash)
49 #define mro_method_changed_in(stash) ((void)stash, (void)PL_sub_generation++)
50 #define mro_get_pkg_gen(stash) ((void)stash, PL_sub_generation)
51 #define mro_get_cache_gen(stash) ((void)stash, (U32)0)
52 #define mro_get_gen(stash) ((void)stash, PL_sub_generation)
55 #if defined(NEED_mro_get_linear_isa) && !defined(NEED_mro_get_linear_isa_GLOBAL)
56 static AV* my_mro_get_linear_isa(pTHX_ HV* const stash);
59 extern AV* my_mro_get_linear_isa(pTHX_ HV* const stash);
60 #endif /* !NEED_mro_get_linear_isa */
62 #if defined(NEED_mro_get_linear_isa) || defined(NEED_mro_get_linear_isa_GLOBAL)
63 #define ISA_CACHE "::LINEALIZED_ISA_CACHE::"
65 /* call &mro::get_linear_isa, which is actually &MRO::Compat::__get_linear_isa */
67 my_mro_get_linear_isa(pTHX_ HV* const stash){
69 AV* isa; /* linearized ISA cache */
70 SV* gen; /* package generation */
73 assert(stash != NULL);
74 assert(SvTYPE(stash) == SVt_PVHV);
76 cachegv = *(GV**)hv_fetchs(stash, ISA_CACHE, TRUE);
78 gv_init(cachegv, stash, ISA_CACHE, sizeof(ISA_CACHE)-1, GV_ADD);
87 if(SvIOK(gen) && SvIVX(gen) == (IV)mro_get_pkg_gen(stash)){
88 return isa; /* returns the cache if available */
95 get_linear_isa = get_cv("mro::get_linear_isa", FALSE);
100 Perl_load_module(aTHX_ PERL_LOADMOD_NOIMPORT, newSVpvs("MRO::Compat"), NULL, NULL);
101 get_linear_isa = get_cv("mro::get_linear_isa", TRUE);
115 mXPUSHp(HvNAME(stash), strlen(HvNAME(stash)));
118 call_sv((SV*)get_linear_isa, G_SCALAR);
124 if(SvROK(avref) && SvTYPE(SvRV(avref)) == SVt_PVAV){
125 AV* const av = (AV*)SvRV(avref);
126 I32 const len = AvFILLp(av) + 1;
129 for(i = 0; i < len; i++){
130 HV* const st = gv_stashsv(AvARRAY(av)[i], FALSE);
132 av_push(isa, newSVpv(HvNAME(st), 0));
137 Perl_croak(aTHX_ "panic: mro::get_linear_isa() didn't return an ARRAY reference");
144 sv_setiv(gen, (IV)mro_get_pkg_gen(stash));
149 #endif /* !(defined(NEED_mro_get_linear_isa) || defined(NEED_mro_get_linear_isa_GLOBAL)) */
151 #endif /* end of the file */