Change and create new constraints with some failing tests
Yuval Kogman [Fri, 21 Apr 2006 18:22:23 +0000 (18:22 +0000)]
lib/Moose/Util/TypeConstraints.pm
t/002_basic.t
t/006_basic.t
t/007_basic.t
t/054_util_type_coercion.t

index d987f0e..0a81da0 100644 (file)
@@ -112,12 +112,14 @@ subtype 'Defined' => as 'Item' => where {  defined($_) };
 subtype 'Value' => as 'Item' => where { !ref($_) };
 subtype 'Ref'   => as 'Item' => where {  ref($_) };
 
-subtype 'Bool'  => as 'Item' => where { "$_" eq '1' || "$_" eq '0' };
+subtype 'Bool'  => as 'Item' => where { !defined($_) || $_ eq "" || "$_" eq '1' || "$_" eq '0' };
 
-subtype 'Int' => as 'Value' => where {  Scalar::Util::looks_like_number($_) };
-subtype 'Str' => as 'Value' => where { !Scalar::Util::looks_like_number($_) };
+subtype 'Str' => as 'Value' => where { defined($_) };
 
-subtype 'ScalarRef' => as 'Ref' => where { ref($_) eq 'SCALAR' };      
+subtype 'Num' => as 'Value' => where { Scalar::Util::looks_like_number($_) };
+subtype 'Int' => as 'Num'   => where { "$_" =~ /^[0-9]+$/ };
+
+subtype 'ScalarRef' => as 'Ref' => where { ref($_) eq 'SCALAR' };
 
 subtype 'CollectionRef' => as 'Ref' => where { ref($_) eq 'ARRAY' || ref($_) eq 'HASH' };
 
@@ -303,4 +305,4 @@ L<http://www.iinteractive.com>
 This library is free software; you can redistribute it and/or modify
 it under the same terms as Perl itself. 
 
-=cut
\ No newline at end of file
+=cut
index 5f81bfb..0e0b3ed 100644 (file)
@@ -16,7 +16,7 @@ BEGIN {
        use warnings;
     use Moose;
     
-    has 'balance' => (isa => 'Int', is => 'rw', default => 0);
+    has 'balance' => (isa => 'Num', is => 'rw', default => 0);
 
     sub deposit {
         my ($self, $amount) = @_;
index 52efb19..27f79ea 100644 (file)
@@ -70,7 +70,7 @@ BEGIN {
     
     with 'Ord';
     
-    has 'amount' => (is => 'rw', isa => 'Int', default => 0);
+    has 'amount' => (is => 'rw', isa => 'Num', default => 0);
     
     sub compare {
         my ($self, $other) = @_;
index 75b416f..ebd2bf3 100644 (file)
@@ -18,7 +18,7 @@ BEGIN {
     use warnings;
     use Moose::Role;
 
-    has 'value' => (isa => 'Int', is => 'ro');
+    has 'value' => (isa => 'Num', is => 'ro');
 
     around 'validate' => sub {
         my $c = shift;
index 6a1669c..e1f7f42 100644 (file)
@@ -29,6 +29,21 @@ coerce Header
         => via { HTTPHeader->new(array => $_[0]) }
     => from HashRef 
         => via { HTTPHeader->new(hash => $_[0]) };
+
+
+{
+       package Math::BigFloat;
+       sub new { bless { }, shift }; # not a moose class ;-)
+}
+
+subtype "Math::BigFloat"
+       => as "Math::BigFloat"
+       => where { 1 };
+
+coerce "Math::BigFloat"
+       => from Num
+               => via { Math::BigFloat->new( $_ ) };
+
         
 Moose::Util::TypeConstraints->export_type_contstraints_as_functions();