Fix an issue on the Int type constraint, to accept 2*46 as Int and to refuse 2**46...

diff --git a/lib/Mouse/PurePerl.pm b/lib/Mouse/PurePerl.pm
index 18620c5..439217f 100644 (file)
--- a/lib/Mouse/PurePerl.pm
+++ b/lib/Mouse/PurePerl.pm
@@ -148,12 +148,7 @@ sub Value      {  defined($_[0]) && !ref($_[0]) }
 sub Num        {  looks_like_number($_[0]) }
 sub Int        {
     my($value) = @_;
-    looks_like_number($value) && do{
-        # work around RT #55048
-        # This is for more than 32 bit int on 32 bit systems
-        require POSIX;
-        POSIX::fmod($value, 1) == 0;
-    };
+    looks_like_number($value) && $value =~ /\A [+-]? [0-9]+  \z/xms;
 }
 sub Str        {
     my($value) = @_;

diff --git a/t/900_bug/005_large_int.t b/t/900_bug/005_large_int.t
index 2d65957..c6982b9 100644 (file)
--- a/t/900_bug/005_large_int.t
+++ b/t/900_bug/005_large_int.t
@@ -1,3 +1,4 @@
+# See also http://rt.cpan.org/Public/Bug/Display.html?id=55048
 package MyInteger;
 use Mouse;
 
@@ -12,12 +13,25 @@ has a_num => (
 );
 
 package main;
-use Test::More tests => 212 * 2;
+use Test::More tests => 24;
 
-for (my $i = 1; $i <= 10e100; $i += $i * 2) {
-    my $int = MyInteger->new( a_int => $i )->a_int;
-    cmp_ok($int, '==', $i, "Mouse groked the Int $i");
+foreach my $i(2**32, 2**40, 2**46) {
+    for my $sig(1, -1) {
+        my $value = $i * $sig;
 
-    my $num = MyInteger->new( a_num => $i )->a_num;
-    cmp_ok($num, '==', $i, "Mouse groked the Num $i");
+        my $int = MyInteger->new( a_int => $value )->a_int;
+        cmp_ok($int, '==', $value, "Mouse groked the Int $i");
+
+
+        my $num = MyInteger->new( a_num => $value )->a_num;
+        cmp_ok($num, '==', $value, "Mouse groked the Num $i");
+
+        $value += 0.5;
+
+        eval { MyInteger->new( a_int => $value ) };
+        like $@, qr/does not pass the type constraint/, "Mouse does not regard $value as Int";
+        eval { MyInteger->new( a_num => $value ) };
+        is $@, '', "Mouse regards $value as Num";
+    }
 }
+

diff --git a/xs-src/MouseTypeConstraints.xs b/xs-src/MouseTypeConstraints.xs
index e19cd99..09cf92c 100644 (file)
--- a/xs-src/MouseTypeConstraints.xs
+++ b/xs-src/MouseTypeConstraints.xs
@@ -118,15 +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);
-        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);