Tweaks

[gitmo/Mouse.git] / xs-src / MouseTypeConstraints.xs

diff --git a/xs-src/MouseTypeConstraints.xs b/xs-src/MouseTypeConstraints.xs
index e19cd99..420703e 100644 (file)
--- a/xs-src/MouseTypeConstraints.xs
+++ b/xs-src/MouseTypeConstraints.xs
@@ -117,6 +117,30 @@ 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);
@@ -124,9 +148,7 @@ mouse_tc_Int(pTHX_ SV* const data PERL_UNUSED_DECL, SV* const sv) {
         return TRUE;
     }
     else if(SvNOKp(sv)) {
-        NV const nv = SvNVX(sv);
-        NV mod = Perl_fmod( nv, 1 );
-        return mod == 0;
+        return S_nv_is_integer(aTHX_ SvNVX(sv));
     }
     else if(SvPOKp(sv)){
         int const num_type = grok_number(SvPVX(sv), SvCUR(sv), NULL);
@@ -703,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));
         }
@@ -722,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
+