X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=xs-src%2FMouseTypeConstraints.xs;h=bf07619554680a388e3dad81a7ff784261fb0dea;hb=d6ceb359d08b474a9f0911c7d7c3fd319761b0ae;hp=a7ff3905bdc72d73d2834589d1dd8e3084306179;hpb=1f1ccccdb5564d10867ffb11df17a5155999a62a;p=gitmo%2FMouse.git

diff --git a/xs-src/MouseTypeConstraints.xs b/xs-src/MouseTypeConstraints.xs
index a7ff390..bf07619 100644
--- a/xs-src/MouseTypeConstraints.xs
+++ b/xs-src/MouseTypeConstraints.xs
@@ -7,7 +7,7 @@
 #if PERL_BCDVERSION >= 0x5008005
 #define LooksLikeNumber(sv) looks_like_number(sv)
 #else
-#define LooksLikeNumber(sv) ( SvPOKp(sv) ? looks_like_number(sv) : SvNIOKp(sv) )
+#define LooksLikeNumber(sv) ( SvPOKp(sv) ? looks_like_number(sv) : (I32)SvNIOKp(sv) )
 #endif
 
 #ifndef SvRXOK
@@ -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);
     }
@@ -117,12 +117,39 @@ 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) || SvNOKp(sv)){
+    if(SvIOKp(sv)){
         return TRUE;
     }
+    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);
         if(num_type){
@@ -383,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;
@@ -444,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;
@@ -718,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));
         }
@@ -737,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
+