X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=xs-src%2Fmouse_util.xs;h=94239c86eba82042e6e1c986e75301cf950dc64c;hb=a5df48e596d4b685f53bf59ef581d6999ab14eb6;hp=5da40717a9b723441de9445159eb1b1fe947fcef;hpb=431657256f423bda264c0cb76c28de72fd879b20;p=gitmo%2FMouse.git diff --git a/xs-src/mouse_util.xs b/xs-src/mouse_util.xs index 5da4071..94239c8 100644 --- a/xs-src/mouse_util.xs +++ b/xs-src/mouse_util.xs @@ -1,5 +1,118 @@ #include "mouse.h" +#define ISA_CACHE "::LINEALIZED_ISA_CACHE::" + +#ifdef no_mro_get_linear_isa +AV* +mouse_mro_get_linear_isa(pTHX_ HV* const stash){ + GV* const cachegv = *(GV**)hv_fetchs(stash, ISA_CACHE, TRUE); + AV* isa; + SV* gen; + CV* get_linear_isa; + + if(!isGV(cachegv)) + gv_init(cachegv, stash, ISA_CACHE, sizeof(ISA_CACHE)-1, TRUE); + + isa = GvAVn(cachegv); + gen = GvSVn(cachegv); + + + if(SvIOK(gen) && SvIVX(gen) == (IV)mro_get_pkg_gen(stash)){ + return isa; /* returns the cache if available */ + } + else{ + SvREADONLY_off(isa); + av_clear(isa); + } + + get_linear_isa = get_cv("Mouse::Util::get_linear_isa", TRUE); + + { + SV* avref; + dSP; + + ENTER; + SAVETMPS; + + PUSHMARK(SP); + mXPUSHp(HvNAME_get(stash), HvNAMELEN_get(stash)); + PUTBACK; + + call_sv((SV*)get_linear_isa, G_SCALAR); + + SPAGAIN; + avref = POPs; + PUTBACK; + + if(SvROK(avref) && SvTYPE(SvRV(avref)) == SVt_PVAV){ + AV* const av = (AV*)SvRV(avref); + I32 const len = AvFILLp(av) + 1; + I32 i; + + for(i = 0; i < len; i++){ + HV* const stash = gv_stashsv(AvARRAY(av)[i], FALSE); + if(stash) + av_push(isa, newSVpv(HvNAME(stash), 0)); + } + SvREADONLY_on(isa); + } + else{ + Perl_croak(aTHX_ "Mouse:Util::get_linear_isa() didn't return an ARRAY reference"); + } + + FREETMPS; + LEAVE; + } + + sv_setiv(gen, (IV)mro_get_pkg_gen(stash)); + return GvAV(cachegv); +} +#endif /* !no_mor_get_linear_isa */ + +#ifdef DEBUGGING +SV** +mouse_av_at_safe(pTHX_ AV* const av, I32 const ix){ + assert(av); + assert(SvTYPE(av) == SVt_PVAV); + assert(AvMAX(av) >= ix); + return &AvARRAY(av)[ix]; +} +#endif + +void +mouse_throw_error(SV* const metaobject, SV* const data /* not used */, const char* const fmt, ...){ + dTHX; + va_list args; + SV* message; + + PERL_UNUSED_ARG(data); /* for moose-compat */ + + assert(metaobject); + assert(fmt); + + va_start(args, fmt); + message = vnewSVpvf(fmt, &args); + va_end(args); + + { + dSP; + PUSHMARK(SP); + EXTEND(SP, 4); + + PUSHs(metaobject); + mPUSHs(message); + + mPUSHs(newSVpvs("depth")); + mPUSHi(-1); + + PUTBACK; + + call_method("throw_error", G_VOID); + croak("throw_error() did not throw the error (%"SVf")", message); + } +} + + /* equivalent to "blessed($x) && $x->isa($klass)" */ bool mouse_is_instance_of(pTHX_ SV* const sv, SV* const klass){