The last commit didn't correctly catch 1 v.s. 1.5, use Perl's fmod function to check...

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

diff --git a/xs-src/MouseTypeConstraints.xs b/xs-src/MouseTypeConstraints.xs
index fb3ab4e..7068a5b 100644 (file)
--- a/xs-src/MouseTypeConstraints.xs
+++ b/xs-src/MouseTypeConstraints.xs
@@ -16,11 +16,15 @@
 
 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);
     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;
 
@@ -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;
         }
@@ -119,9 +123,10 @@ mouse_tc_Int(pTHX_ SV* const data PERL_UNUSED_DECL, SV* const sv) {
     if(SvIOKp(sv)){
         return TRUE;
     }
-    else if(SvNOKp(sv)){
+    else if(SvNOKp(sv)) {
         NV const nv = SvNVX(sv);
-        return nv > 0 ? (nv == (NV)(UV)nv) : (nv == (NV)(IV)nv);
+        NV mod = Perl_fmod( nv, 1 );
+        return mod == 0;
     }
     else if(SvPOKp(sv)){
         int const num_type = grok_number(SvPVX(sv), SvCUR(sv), NULL);
@@ -244,7 +249,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;
             }
@@ -263,7 +267,6 @@ 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;
@@ -409,9 +412,7 @@ mouse_is_an_instance_of(pTHX_ HV* const stash, SV* const instance){
             call_sv((SV*)instance_isa, G_SCALAR);
 
             SPAGAIN;
-
-            retval = SvTRUEx(POPs);
-
+            retval = sv_true(POPs);
             PUTBACK;
 
             FREETMPS;
@@ -462,8 +463,7 @@ mouse_can_methods(pTHX_ AV* const methods, SV* const instance){
                 call_method("can", G_SCALAR);
 
                 SPAGAIN;
-                ok = SvTRUE(TOPs);
-                (void)POPs;
+                ok = sv_true(POPs);
                 PUTBACK;
 
                 FREETMPS;
@@ -491,7 +491,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 */
     );
 
@@ -507,18 +507,18 @@ 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);
@@ -531,10 +531,7 @@ mouse_generate_can_predicate_for(pTHX_ SV* const methods, const char* const pred
     I32 len;
     I32 i;
 
-    SvGETMAGIC(methods);
-    if(!IsArrayRef(methods)){
-        croak("You must pass an ARRAY ref method names");
-    }
+    must_ref(methods, "an ARRAY ref for method names", SVt_PVAV);
     av = (AV*)SvRV(methods);
 
     len = av_len(av) + 1;
@@ -660,10 +657,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)
@@ -739,6 +739,6 @@ 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);
 }