From: Stevan Little Date: Tue, 18 Apr 2006 03:01:52 +0000 (+0000) Subject: Bool-n-CollectionRef X-Git-Tag: 0_05~26 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=5204cd524513bcb54658c916b3d4b14cc8c37b94;p=gitmo%2FMoose.git Bool-n-CollectionRef --- diff --git a/Changes b/Changes index c6de4f8..bb4ce62 100644 --- a/Changes +++ b/Changes @@ -1,5 +1,11 @@ Revision history for Perl extension Moose +0.05 + * Moose::Utils::TypeConstraints + - added Bool type and CollectionRef type + then made ArrayRef and HashRef into subtypes + of the CollectionRef + 0.04 Sun. April 16th, 2006 * Moose::Role - Roles can now consume other roles diff --git a/lib/Moose/Util/TypeConstraints.pm b/lib/Moose/Util/TypeConstraints.pm index 2db83f4..75dc8a6 100644 --- a/lib/Moose/Util/TypeConstraints.pm +++ b/lib/Moose/Util/TypeConstraints.pm @@ -7,7 +7,7 @@ use warnings; use Carp 'confess'; use Scalar::Util 'blessed'; -our $VERSION = '0.04'; +our $VERSION = '0.05'; use Moose::Meta::TypeConstraint; use Moose::Meta::TypeCoercion; @@ -103,12 +103,18 @@ type 'Any' => where { 1 }; subtype 'Value' => as 'Any' => where { !ref($_) }; subtype 'Ref' => as 'Any' => where { ref($_) }; +subtype 'Bool' => as 'Any' => where { "$_" 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 'ScalarRef' => as 'Ref' => where { ref($_) eq 'SCALAR' }; -subtype 'ArrayRef' => as 'Ref' => where { ref($_) eq 'ARRAY' }; -subtype 'HashRef' => as 'Ref' => where { ref($_) eq 'HASH' }; + +subtype 'CollectionRef' => as 'Ref' => where { ref($_) eq 'ARRAY' || ref($_) eq 'HASH' }; + +subtype 'ArrayRef' => as 'CollectionRef' => where { ref($_) eq 'ARRAY' }; +subtype 'HashRef' => as 'CollectionRef' => where { ref($_) eq 'HASH' }; + subtype 'CodeRef' => as 'Ref' => where { ref($_) eq 'CODE' }; subtype 'RegexpRef' => as 'Ref' => where { ref($_) eq 'Regexp' }; @@ -168,17 +174,19 @@ This module also provides a simple hierarchy for Perl 5 types, this could probably use some work, but it works for me at the moment. Any + Bool Value Int Str Ref ScalarRef - ArrayRef - HashRef + CollectionRef + ArrayRef + HashRef CodeRef RegexpRef Object - Role + Role Suggestions for improvement are welcome. diff --git a/t/052_util_std_type_constraints.t b/t/052_util_std_type_constraints.t index 3432e23..df63a1b 100644 --- a/t/052_util_std_type_constraints.t +++ b/t/052_util_std_type_constraints.t @@ -3,7 +3,7 @@ use strict; use warnings; -use Test::More tests => 122; +use Test::More tests => 143; use Test::Exception; use Scalar::Util (); @@ -27,6 +27,18 @@ ok(defined Any($SCALAR_REF), '... Any accepts anything'); ok(defined Any(qr/../), '... Any accepts anything'); ok(defined Any(bless {}, 'Foo'), '... Any accepts anything'); +ok(defined Bool(0), '... Bool rejects anything which is not a 1 or 0'); +ok(defined Bool(1), '... Bool rejects anything which is not a 1 or 0'); +ok(!defined Bool(100), '... Bool rejects anything which is not a 1 or 0'); +ok(!defined Bool(''), '... Bool rejects anything which is not a 1 or 0'); +ok(!defined Bool('Foo'), '... Bool rejects anything which is not a 1 or 0'); +ok(!defined Bool([]), '... Bool rejects anything which is not a 1 or 0'); +ok(!defined Bool({}), '... Bool rejects anything which is not a 1 or 0'); +ok(!defined Bool(sub {}), '... Bool rejects anything which is not a 1 or 0'); +ok(!defined Bool($SCALAR_REF), '... Bool rejects anything which is not a 1 or 0'); +ok(!defined Bool(qr/../), '... Bool rejects anything which is not a 1 or 0'); +ok(!defined Bool(bless {}, 'Foo'), '... Bool rejects anything which is not a 1 or 0'); + ok(defined Value(0), '... Value accepts anything which is not a Ref'); ok(defined Value(100), '... Value accepts anything which is not a Ref'); ok(defined Value(''), '... Value accepts anything which is not a Ref'); @@ -82,6 +94,17 @@ ok(defined ScalarRef($SCALAR_REF), '... ScalarRef accepts anything which i ok(!defined ScalarRef(qr/../), '... ScalarRef rejects anything which is not a ScalarRef'); ok(!defined ScalarRef(bless {}, 'Foo'), '... ScalarRef rejects anything which is not a ScalarRef'); +ok(!defined CollectionRef(0), '... CollectionRef rejects anything which is not a HASH or ARRAY'); +ok(!defined CollectionRef(100), '... CollectionRef rejects anything which is not a HASH or ARRAY'); +ok(!defined CollectionRef(''), '... CollectionRef rejects anything which is not a HASH or ARRAY'); +ok(!defined CollectionRef('Foo'), '... CollectionRef rejects anything which is not a HASH or ARRAY'); +ok(defined CollectionRef([]), '... CollectionRef accepts anything which is not a HASH or ARRAY'); +ok(defined CollectionRef({}), '... CollectionRef rejects anything which is not a HASH or ARRAY'); +ok(!defined CollectionRef(sub {}), '... CollectionRef rejects anything which is not a HASH or ARRAY'); +ok(!defined CollectionRef($SCALAR_REF), '... CollectionRef rejects anything which is not a HASH or ARRAY'); +ok(!defined CollectionRef(qr/../), '... CollectionRef rejects anything which is not a HASH or ARRAY'); +ok(!defined CollectionRef(bless {}, 'Foo'), '... CollectionRef rejects anything which is not a HASH or ARRAY'); + ok(!defined ArrayRef(0), '... ArrayRef rejects anything which is not a ArrayRef'); ok(!defined ArrayRef(100), '... ArrayRef rejects anything which is not a ArrayRef'); ok(!defined ArrayRef(''), '... ArrayRef rejects anything which is not a ArrayRef'); diff --git a/t/053_util_find_type_constraint.t b/t/053_util_find_type_constraint.t index 0f843f8..9d77f39 100644 --- a/t/053_util_find_type_constraint.t +++ b/t/053_util_find_type_constraint.t @@ -3,7 +3,7 @@ use strict; use warnings; -use Test::More tests => 12; +use Test::More tests => 15; use Test::Exception; BEGIN { @@ -12,16 +12,19 @@ BEGIN { foreach my $type_name (qw( Any + Bool Value Int Str Ref ScalarRef - ArrayRef - HashRef + CollectionRef + ArrayRef + HashRef CodeRef RegexpRef Object + Role )) { is(find_type_constraint($type_name)->name, $type_name,