X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=xs-src%2FMouseTypeConstraints.xs;h=420703e3808aaa7c9f3f3e1f07edfd01ad9c74af;hb=f0e1969bc2752f79154513a6df9b46571ee3e8ba;hp=2f4a6b125c599e51aac2c6de35e6f1faa0a52577;hpb=6fab29c627e6fa346e3aab08de0017b46eeb3ddb;p=gitmo%2FMouse.git diff --git a/xs-src/MouseTypeConstraints.xs b/xs-src/MouseTypeConstraints.xs index 2f4a6b1..420703e 100644 --- a/xs-src/MouseTypeConstraints.xs +++ b/xs-src/MouseTypeConstraints.xs @@ -16,6 +16,9 @@ typedef int (*check_fptr_t)(pTHX_ SV* const data, SV* const sv); +/* + NOTE: mouse_tc_check() handles GETMAGIC +*/ int mouse_tc_check(pTHX_ SV* const tc_code, SV* const sv) { CV* const cv = (CV*)SvRV(tc_code); @@ -27,6 +30,7 @@ mouse_tc_check(pTHX_ SV* const tc_code, SV* const sv) { assert(CvXSUBANY(cv).any_ptr != NULL); assert(mg->mg_ptr != NULL); + SvGETMAGIC(sv); /* call the check function directly, skipping call_sv() */ return CALL_FPTR((check_fptr_t)mg->mg_ptr)(aTHX_ mg->mg_obj, sv); } @@ -44,7 +48,7 @@ mouse_tc_check(pTHX_ SV* const tc_code, SV* const sv) { call_sv(tc_code, G_SCALAR); SPAGAIN; - ok = SvTRUEx(POPs); + ok = sv_true(POPs); PUTBACK; FREETMPS; @@ -69,7 +73,7 @@ int mouse_tc_Bool(pTHX_ SV* const data PERL_UNUSED_DECL, SV* const sv) { assert(sv); - if(SvTRUE(sv)){ + if(sv_true(sv)){ if(SvIOKp(sv)){ return SvIVX(sv) == 1; } @@ -84,7 +88,7 @@ mouse_tc_Bool(pTHX_ SV* const data PERL_UNUSED_DECL, SV* const sv) { } } else{ - /* false must be boolean */ + /* any false value must be boolean */ return TRUE; } } @@ -113,15 +117,38 @@ mouse_tc_Num(pTHX_ SV* const data PERL_UNUSED_DECL, SV* const sv) { return LooksLikeNumber(sv); } +static int +S_nv_is_integer(pTHX_ NV const nv) { + if(nv == (NV)(IV)nv){ + return TRUE; + } + else { + char buf[64]; /* Must fit sprintf/Gconvert of longest NV */ + char* p; + Gconvert(nv, NV_DIG, 0, buf); + p = &buf[0]; + + /* -?[0-9]+ */ + if(*p == '-') p++; + + while(*p){ + if(!isDIGIT(*p)){ + return FALSE; + } + p++; + } + return TRUE; + } +} + int mouse_tc_Int(pTHX_ SV* const data PERL_UNUSED_DECL, SV* const sv) { assert(sv); if(SvIOKp(sv)){ return TRUE; } - else if(SvNOKp(sv)){ - NV const nv = SvNVX(sv); - return nv > 0 ? (nv == (NV)(UV)nv) : (nv == (NV)(IV)nv); + else if(SvNOKp(sv)) { + return S_nv_is_integer(aTHX_ SvNVX(sv)); } else if(SvPOKp(sv)){ int const num_type = grok_number(SvPVX(sv), SvCUR(sv), NULL); @@ -170,9 +197,13 @@ mouse_tc_Ref(pTHX_ SV* const data PERL_UNUSED_DECL, SV* const sv) { } int -mouse_tc_ScalarRef(pTHX_ SV* const data PERL_UNUSED_DECL, SV* const sv) { +mouse_tc_ScalarRef(pTHX_ SV* const data PERL_UNUSED_DECL, SV* sv) { assert(sv); - return SvROK(sv) && !SvOBJECT(SvRV(sv)) && (SvTYPE(SvRV(sv)) <= SVt_PVLV && !isGV(SvRV(sv))); + if(SvROK(sv)){ + sv = SvRV(sv); + return !SvOBJECT(sv) && (SvTYPE(sv) <= SVt_PVLV && !isGV(sv)); + } + return FALSE; } int @@ -240,7 +271,6 @@ mouse_parameterized_ArrayRef(pTHX_ SV* const param, SV* const sv) { I32 i; for(i = 0; i < len; i++){ SV* const value = *av_fetch(av, i, TRUE); - SvGETMAGIC(value); if(!mouse_tc_check(aTHX_ param, value)){ return FALSE; } @@ -259,8 +289,8 @@ mouse_parameterized_HashRef(pTHX_ SV* const param, SV* const sv) { hv_iterinit(hv); while((he = hv_iternext(hv))){ SV* const value = hv_iterval(hv, he); - SvGETMAGIC(value); if(!mouse_tc_check(aTHX_ param, value)){ + hv_iterinit(hv); /* reset */ return FALSE; } } @@ -319,6 +349,7 @@ mouse_types_check(pTHX_ AV* const types, SV* const sv) { #define MY_CXT_KEY "Mouse::Util::TypeConstraints::_guts" XS_VERSION typedef struct sui_cxt{ GV* universal_isa; + GV* universal_can; } my_cxt_t; START_MY_CXT @@ -358,6 +389,19 @@ mouse_lookup_isa(pTHX_ HV* const instance_stash, const char* const klass_pv){ return FALSE; } +#define find_method_pvn(a, b, c) mouse_stash_find_method(aTHX_ a, b, c) +#define find_method_pvs(a, b) mouse_stash_find_method(aTHX_ a, STR_WITH_LEN(b)) + +static inline GV* +mouse_stash_find_method(pTHX_ HV* const stash, const char* const name, I32 const namelen){ + GV** const gvp = (GV**)hv_fetch(stash, name, namelen, FALSE); + if(gvp && isGV(*gvp) && GvCV(*gvp)){ /* shortcut */ + return *gvp; + } + + return gv_fetchmeth_autoload(stash, name, namelen, 0); +} + int mouse_is_an_instance_of(pTHX_ HV* const stash, SV* const instance){ assert(stash); @@ -366,39 +410,28 @@ mouse_is_an_instance_of(pTHX_ HV* const stash, SV* const instance){ if(IsObject(instance)){ dMY_CXT; HV* const instance_stash = SvSTASH(SvRV(instance)); - GV* const instance_isa = gv_fetchmeth_autoload(instance_stash, "isa", sizeof("isa")-1, 0); + GV* const myisa = find_method_pvs(instance_stash, "isa"); /* the instance has no own isa method */ - if(instance_isa == NULL || GvCV(instance_isa) == GvCV(MY_CXT.universal_isa)){ + if(myisa == NULL || GvCV(myisa) == GvCV(MY_CXT.universal_isa)){ return stash == instance_stash || mouse_lookup_isa(aTHX_ instance_stash, HvNAME_get(stash)); } /* the instance has its own isa method */ else { - int retval; - dSP; + SV* package; + int ok; ENTER; SAVETMPS; - PUSHMARK(SP); - EXTEND(SP, 2); - PUSHs(instance); - mPUSHp(HvNAME_get(stash), HvNAMELEN_get(stash)); - PUTBACK; - - call_sv((SV*)instance_isa, G_SCALAR); - - SPAGAIN; - - retval = SvTRUEx(POPs); - - PUTBACK; + package = newSVpvn_share(HvNAME_get(stash), HvNAMELEN_get(stash), 0U); + ok = sv_true(mcall1s(instance, "isa", sv_2mortal(package))); FREETMPS; LEAVE; - return retval; + return ok; } } return FALSE; @@ -410,6 +443,44 @@ mouse_is_an_instance_of_universal(pTHX_ SV* const data, SV* const sv){ return SvROK(sv) && SvOBJECT(SvRV(sv)); } +static int +mouse_can_methods(pTHX_ AV* const methods, SV* const instance){ + if(IsObject(instance)){ + dMY_CXT; + HV* const mystash = SvSTASH(SvRV(instance)); + GV* const mycan = find_method_pvs(mystash, "can"); + bool const use_builtin = (mycan == NULL || GvCV(mycan) == GvCV(MY_CXT.universal_can)) ? TRUE : FALSE; + I32 const len = AvFILLp(methods) + 1; + I32 i; + for(i = 0; i < len; i++){ + SV* const name = MOUSE_av_at(methods, i); + + if(use_builtin){ + if(!find_method_pvn(mystash, SvPVX(name), SvCUR(name))){ + return FALSE; + } + } + else{ + bool ok; + + ENTER; + SAVETMPS; + + ok = sv_true(mcall1s(instance, "can", sv_mortalcopy(name))); + + FREETMPS; + LEAVE; + + if(!ok){ + return FALSE; + } + } + } + return TRUE; + } + return FALSE; +} + static MGVTBL mouse_util_type_constraints_vtbl; /* not used, only for identity */ static CV* @@ -422,7 +493,7 @@ mouse_tc_generate(pTHX_ const char* const name, check_fptr_t const fptr, SV* con param, /* mg_obj: refcnt will be increased */ PERL_MAGIC_ext, &mouse_util_type_constraints_vtbl, - (void*)fptr, /* mg_ptr */ + (char*)fptr, /* mg_ptr */ 0 /* mg_len: 0 for static data */ ); @@ -438,23 +509,46 @@ mouse_generate_isa_predicate_for(pTHX_ SV* const klass, const char* const predic STRLEN klass_len; const char* klass_pv = SvPV_const(klass, klass_len); SV* param; - void* fptr; + check_fptr_t fptr; klass_pv = mouse_canonicalize_package_name(klass_pv); if(strNE(klass_pv, "UNIVERSAL")){ param = (SV*)gv_stashpvn(klass_pv, klass_len, GV_ADD); - fptr = (void*)mouse_is_an_instance_of; + fptr = (check_fptr_t)mouse_is_an_instance_of; } else{ param = NULL; - fptr = (void*)mouse_is_an_instance_of_universal; + fptr = (check_fptr_t)mouse_is_an_instance_of_universal; } return mouse_tc_generate(aTHX_ predicate_name, fptr, param); } +CV* +mouse_generate_can_predicate_for(pTHX_ SV* const methods, const char* const predicate_name){ + AV* av; + AV* const param = newAV_mortal(); + I32 len; + I32 i; + + must_ref(methods, "an ARRAY ref for method names", SVt_PVAV); + av = (AV*)SvRV(methods); + + len = av_len(av) + 1; + for(i = 0; i < len; i++){ + SV* const name = *av_fetch(av, i, TRUE); + STRLEN pvlen; + const char* const pv = SvPV_const(name, pvlen); + + av_push(param, newSVpvn_share(pv, pvlen, 0U)); + } + + return mouse_tc_generate(aTHX_ predicate_name, (check_fptr_t)mouse_can_methods, (SV*)param); +} + + XS(XS_Mouse_constraint_check) { dVAR; dXSARGS; @@ -473,6 +567,9 @@ static void setup_my_cxt(pTHX_ pMY_CXT){ MY_CXT.universal_isa = gv_fetchpvs("UNIVERSAL::isa", GV_ADD, SVt_PVCV); SvREFCNT_inc_simple_void_NN(MY_CXT.universal_isa); + + MY_CXT.universal_can = gv_fetchpvs("UNIVERSAL::can", GV_ADD, SVt_PVCV); + SvREFCNT_inc_simple_void_NN(MY_CXT.universal_can); } #define DEFINE_TC(name) mouse_tc_generate(aTHX_ "Mouse::Util::TypeConstraints::" STRINGIFY(name), CAT2(mouse_tc_, name), NULL) @@ -562,10 +659,13 @@ BOOT: INSTALL_SIMPLE_READER(TypeConstraint, parent); INSTALL_SIMPLE_READER(TypeConstraint, message); + INSTALL_SIMPLE_READER(TypeConstraint, type_parameter); + INSTALL_SIMPLE_READER_WITH_KEY(TypeConstraint, _compiled_type_constraint, compiled_type_constraint); INSTALL_SIMPLE_READER(TypeConstraint, _compiled_type_coercion); /* Mouse specific */ INSTALL_SIMPLE_PREDICATE_WITH_KEY(TypeConstraint, has_coercion, _compiled_type_coercion); + INSTALL_SIMPLE_PREDICATE_WITH_KEY(TypeConstraint, __is_parameterized, type_parameter); /* Mouse specific */ void compile_type_constraint(SV* self) @@ -625,8 +725,7 @@ CODE: SV* const tc = *av_fetch(types, i, TRUE); SV* const c = get_slots(tc, "compiled_type_constraint"); if(!(c && mouse_tc_CodeRef(aTHX_ NULL, c))){ - sv_dump(self); - croak("'%"SVf"' has no compiled type constraint", self); + mouse_throw_error(self, c, "'%"SVf"' has no compiled type constraint", self); } av_push(union_checks, newSVsv(c)); } @@ -641,6 +740,19 @@ CODE: else{ check = newRV_inc((SV*)mouse_tc_generate(aTHX_ NULL, (check_fptr_t)mouse_types_check, (SV*)checks)); } - set_slots(self, "compiled_type_constraint", check); + (void)set_slots(self, "compiled_type_constraint", check); +} + +bool +check(SV* self, SV* sv) +CODE: +{ + SV* const check = get_slots(self, "compiled_type_constraint"); + if(!(check && mouse_tc_CodeRef(aTHX_ NULL, check))){ + mouse_throw_error(self, check, "'%"SVf"' has no compiled type constraint", self); + } + RETVAL = mouse_tc_check(aTHX_ check, sv) ? TRUE : FALSE; } +OUTPUT: + RETVAL