X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=xs-src%2FMouseUtil.xs;h=828982857161ec3e8321fd99180deb1984aa9bcd;hb=1b812057da4c97ecef7dcd723ac05e249e5d6d4b;hp=0e2ae3b454ff42dd5da8a3d340cff59c759a1513;hpb=646c0371bdfda5817f842c54577c4d5605a4c3c0;p=gitmo%2FMouse.git diff --git a/xs-src/MouseUtil.xs b/xs-src/MouseUtil.xs index 0e2ae3b..8289828 100644 --- a/xs-src/MouseUtil.xs +++ b/xs-src/MouseUtil.xs @@ -5,67 +5,67 @@ #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); + 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(IsArrayRef(avref)){ + 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 */ @@ -112,31 +112,6 @@ mouse_throw_error(SV* const metaobject, SV* const data /* not used */, const cha } } - -/* equivalent to "blessed($x) && $x->isa($klass)" */ -bool -mouse_is_instance_of(pTHX_ SV* const sv, SV* const klass){ - assert(sv); - assert(klass); - - if(IsObject(sv) && SvOK(klass)){ - bool ok; - - ENTER; - SAVETMPS; - - ok = SvTRUEx(mcall1s(sv, "isa", klass)); - - FREETMPS; - LEAVE; - - return ok; - } - - return FALSE; -} - - bool mouse_is_class_loaded(pTHX_ SV * const klass){ HV *stash; @@ -312,40 +287,28 @@ OUTPUT: RETVAL void -generate_isa_predicate_for(SV* klass, const char* predicate_name = NULL) +generate_isa_predicate_for(SV* klass, SV* predicate_name = NULL) PPCODE: { - STRLEN klass_len; - const char* klass_pv; - HV* stash; + const char* name_pv = NULL; CV* xsub; + SvGETMAGIC(klass); + if(!SvOK(klass)){ - croak("You must define a class name for generate_for"); + croak("You must define a class name"); } - klass_pv = SvPV_const(klass, klass_len); - klass_pv = mouse_canonicalize_package_name(klass_pv); - if(strNE(klass_pv, "UNIVERSAL")){ - static MGVTBL mouse_util_type_constraints_vtbl; /* not used, only for identity */ - - xsub = newXS(predicate_name, XS_isa_check, __FILE__); - - stash = gv_stashpvn(klass_pv, klass_len, GV_ADD); - - CvXSUBANY(xsub).any_ptr = sv_magicext( - (SV*)xsub, - (SV*)stash, /* mg_obj */ - PERL_MAGIC_ext, - &mouse_util_type_constraints_vtbl, - klass_pv, /* mg_ptr */ - klass_len /* mg_len */ - ); - } - else{ - xsub = newXS(predicate_name, XS_isa_check_for_universal, __FILE__); + if(predicate_name){ + SvGETMAGIC(predicate_name); + if(!SvOK(predicate_name)){ + croak("You must define a predicate_name"); + } + name_pv = SvPV_nolen_const(predicate_name); } + xsub = mouse_generate_isa_predicate_for(aTHX_ klass, name_pv); + if(predicate_name == NULL){ /* anonymous predicate */ XPUSHs( newRV_noinc((SV*)xsub) ); }