From: Yuval Kogman Date: Fri, 21 Apr 2006 18:22:23 +0000 (+0000) Subject: Change and create new constraints with some failing tests X-Git-Tag: 0_05~13 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=81dc201fb52e40afb531c951d3f3b09d0907783c;p=gitmo%2FMoose.git Change and create new constraints with some failing tests --- diff --git a/lib/Moose/Util/TypeConstraints.pm b/lib/Moose/Util/TypeConstraints.pm index d987f0e..0a81da0 100644 --- a/lib/Moose/Util/TypeConstraints.pm +++ b/lib/Moose/Util/TypeConstraints.pm @@ -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 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 diff --git a/t/002_basic.t b/t/002_basic.t index 5f81bfb..0e0b3ed 100644 --- a/t/002_basic.t +++ b/t/002_basic.t @@ -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) = @_; diff --git a/t/006_basic.t b/t/006_basic.t index 52efb19..27f79ea 100644 --- a/t/006_basic.t +++ b/t/006_basic.t @@ -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) = @_; diff --git a/t/007_basic.t b/t/007_basic.t index 75b416f..ebd2bf3 100644 --- a/t/007_basic.t +++ b/t/007_basic.t @@ -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; diff --git a/t/054_util_type_coercion.t b/t/054_util_type_coercion.t index 6a1669c..e1f7f42 100644 --- a/t/054_util_type_coercion.t +++ b/t/054_util_type_coercion.t @@ -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();