X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=xs-src%2FMouseTypeConstraints.xs;h=af6b592caf9f97d2c3f140a805566e867e1ffc55;hb=c7576321a8f564428999a4d9dac5abf923a110a7;hp=34ab1ea8da004f4d0b9f89beac6f14534e774d1f;hpb=d06d926635763fa5687c429b5ad39938c564fbed;p=gitmo%2FMouse.git diff --git a/xs-src/MouseTypeConstraints.xs b/xs-src/MouseTypeConstraints.xs index 34ab1ea..af6b592 100644 --- a/xs-src/MouseTypeConstraints.xs +++ b/xs-src/MouseTypeConstraints.xs @@ -24,13 +24,13 @@ mouse_tc_check(pTHX_ SV* const tc_code, SV* const sv) { CV* const cv = (CV*)SvRV(tc_code); assert(SvTYPE(cv) == SVt_PVCV); - SvGETMAGIC(sv); if(CvXSUB(cv) == XS_Mouse_constraint_check){ /* built-in type constraints */ MAGIC* const mg = (MAGIC*)CvXSUBANY(cv).any_ptr; 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); } @@ -118,14 +118,37 @@ mouse_tc_Num(pTHX_ SV* const data PERL_UNUSED_DECL, SV* const sv) { } 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); @@ -387,37 +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 = find_method_pvs(instance_stash, "isa"); + 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 = sv_true(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; @@ -448,22 +462,11 @@ mouse_can_methods(pTHX_ AV* const methods, SV* const instance){ } else{ bool ok; - dSP; ENTER; SAVETMPS; - PUSHMARK(SP); - EXTEND(SP, 2); - PUSHs(instance); - PUSHs(sv_mortalcopy(name)); - PUTBACK; - - call_method("can", G_SCALAR); - - SPAGAIN; - ok = sv_true(POPs); - PUTBACK; + ok = sv_true(mcall1s(instance, "can", sv_mortalcopy(name))); FREETMPS; LEAVE; @@ -722,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)); } @@ -741,3 +743,16 @@ CODE: (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 +