From: Tomas Doran Date: Tue, 26 Aug 2008 21:09:30 +0000 (+0000) Subject: Add a load of docs to some of the under documented bits of type constraints. I don... X-Git-Tag: 0.55_02~21 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=9758af8af0c362eebb20cf2501eac3f734d7fef3;p=gitmo%2FMoose.git Add a load of docs to some of the under documented bits of type constraints. I don't write great docs, but it's better than it was. Also fix exception in Moose::Meta::TypeConstraint predicate methods, add an exception to Moose::Meta::TypeConstraint::Registry::add_type_constraint if you don't supply something which looks like a type constraint. Couple of other little fixes: warnings, general cleanup and doc additions in the type constraint code. --- diff --git a/Changes b/Changes index 3e6d5e7..19e44fc 100644 --- a/Changes +++ b/Changes @@ -4,6 +4,23 @@ Revision history for Perl extension Moose * Makefile.PL and Moose.pm - explicitly require Perl 5.8.0+ (Dave Rolsky) + * Moose::Util::TypeConstraints + - Fix warnings from find_type_constraint if the type is not + found (t0m). + + * Moose::Meta::TypeConstraint + - predicate methods (equals/is_a_type_of/is_subtype_of) now + return false if the type you specify cannot be found in the + type registry, rather than throwing an unhelpful and coincidental + exception. The behavior is now in line with to + $ob->isa('DoesNotExist') (t0m). + - added docs & test for this (t0m) + + * Moose::Meta::TypeConstraint::Registry + - add_type_constraint now throws an exception if a parameter is + not supplied (t0m). + - added docs & test for this (t0m) + 0.55_01 Wed August 20, 2008 !! Calling Moose::init_meta as a function is now !! diff --git a/lib/Moose/Meta/Attribute.pm b/lib/Moose/Meta/Attribute.pm index 69e6006..93939f4 100644 --- a/lib/Moose/Meta/Attribute.pm +++ b/lib/Moose/Meta/Attribute.pm @@ -511,7 +511,7 @@ sub get_value { if ($self->should_coerce); $type_constraint->check($value) || confess "Attribute (" . $self->name - . "') does not pass the type constraint because: " + . ") does not pass the type constraint because: " . $type_constraint->get_message($value); } $self->set_initial_value($instance, $value); diff --git a/lib/Moose/Meta/TypeConstraint.pm b/lib/Moose/Meta/TypeConstraint.pm index 4d80e7a..7f80067 100644 --- a/lib/Moose/Meta/TypeConstraint.pm +++ b/lib/Moose/Meta/TypeConstraint.pm @@ -95,7 +95,7 @@ sub get_message { sub equals { my ( $self, $type_or_name ) = @_; - my $other = Moose::Util::TypeConstraints::find_type_constraint($type_or_name); + my $other = Moose::Util::TypeConstraints::find_type_constraint($type_or_name) or return; return 1 if refaddr($self) == refaddr($other); @@ -118,7 +118,7 @@ sub equals { sub is_a_type_of { my ($self, $type_or_name) = @_; - my $type = Moose::Util::TypeConstraints::find_type_constraint($type_or_name); + my $type = Moose::Util::TypeConstraints::find_type_constraint($type_or_name) or return; ($self->equals($type) || $self->is_subtype_of($type)); } @@ -126,7 +126,7 @@ sub is_a_type_of { sub is_subtype_of { my ($self, $type_or_name) = @_; - my $type = Moose::Util::TypeConstraints::find_type_constraint($type_or_name); + my $type = Moose::Util::TypeConstraints::find_type_constraint($type_or_name) or return; my $current = $self; @@ -282,13 +282,23 @@ If you wish to use features at this depth, please come to the =item B +This checks the current type against the supplied type (only). +Returns false either if the type name or object supplied +does not match, or if a type name isn't found in the type registry. + =item B -This checks the current type name, and if it does not match, -checks if it is a subtype of it. +This checks the current type against the supplied type, or if the +current type is a sub-type of the type name or object supplied. +Returns false if the current type is not descended from the supplied +type, of if the supplied type isn't found in the type registry. =item B +This checks the current type is a sub-type of the type name or object supplied. +Returns false if the current type is not descended from the supplied +type, of if the supplied type isn't found in the type registry. + =item B =item B @@ -309,10 +319,16 @@ the C will be used to construct a custom error message. =item B +The name of the type in the global type registry. + =item B +The parent type of this type. + =item B +If this type has a parent type. + =item B =item B diff --git a/lib/Moose/Meta/TypeConstraint/Registry.pm b/lib/Moose/Meta/TypeConstraint/Registry.pm index 0607142..59f4ba4 100644 --- a/lib/Moose/Meta/TypeConstraint/Registry.pm +++ b/lib/Moose/Meta/TypeConstraint/Registry.pm @@ -38,11 +38,14 @@ sub has_type_constraint { sub get_type_constraint { my ($self, $type_name) = @_; + return unless defined $type_name; $self->type_constraints->{$type_name} } sub add_type_constraint { my ($self, $type) = @_; + confess("No type supplied / type is not a valid type constraint") + unless ($type && blessed $type && $type->isa('Moose::Meta::TypeConstraint')); $self->type_constraints->{$type->name} = $type; } @@ -94,8 +97,15 @@ base Moose registry and base Moose types will automagically be found too). =item B +Returns a type constraint object from the registry by name. Will return +false if the supplied type name cannot be found. + =item B +Adds a type constraint object to the registry. Will throw an exception if +no type is supplied, or the supplied object does not inherit from +L + =item B =back diff --git a/lib/Moose/Util/TypeConstraints.pm b/lib/Moose/Util/TypeConstraints.pm index 1543efc..76ffc6b 100644 --- a/lib/Moose/Util/TypeConstraints.pm +++ b/lib/Moose/Util/TypeConstraints.pm @@ -241,7 +241,9 @@ sub find_type_constraint ($) { if ( blessed $type and $type->isa("Moose::Meta::TypeConstraint") ) { return $type; - } else { + } + else { + return unless $REGISTRY->has_type_constraint($type); return $REGISTRY->get_type_constraint($type); } } @@ -735,6 +737,10 @@ parameterized, this means you can say: HashRef[CodeRef] # a hash of str to CODE ref mappings Maybe[Str] # value may be a string, may be undefined +B Unless you parameterize a type, then it is invalid to +include the square brackets. I.e. C will be +literally interpreted as a type name. + B The C type constraint for the most part works correctly now, but edge cases may still exist, please use it sparringly. @@ -849,12 +855,21 @@ This is just sugar for the type constraint construction syntax. =item B -This is just sugar for the type constraint construction syntax. +This is just sugar for the type constraint construction syntax. + +Takes a block/code ref as an argument. When the type constraint is tested, +the supplied code is run with the value to be tested in $_. Returning +a true value indicates that the type constraint passes, a false value +indicates that it failed. =item B This is just sugar for the type constraint construction syntax. +Takes a block/code ref as an argument. When the type constraint fails, +then the code block is run (with the value again in $_), and the value +returned is the text of the exception which is thrown. + =item B This can be used to define a "hand optimized" version of your diff --git a/t/040_type_constraints/001_util_type_constraints.t b/t/040_type_constraints/001_util_type_constraints.t index 29d628a..20ceae6 100644 --- a/t/040_type_constraints/001_util_type_constraints.t +++ b/t/040_type_constraints/001_util_type_constraints.t @@ -3,7 +3,7 @@ use strict; use warnings; -use Test::More tests => 38; +use Test::More tests => 44; use Test::Exception; use Scalar::Util (); @@ -104,3 +104,17 @@ is($string->validate(5), lives_ok { Moose::Meta::Attribute->new('bob', isa => 'Spong') } 'meta-attr construction ok even when type constraint utils loaded first'; + +# Test type constraint predicate return values. + +foreach my $predicate (qw/equals is_subtype_of is_a_type_of/) { + ok( !defined $string->$predicate('DoesNotExist'), "$predicate predicate returns undef for non existant constraint"); +} + +# Test adding things which don't look like types to the registry throws an exception + +my $r = Moose::Util::TypeConstraints->get_type_constraint_registry; +throws_ok {$r->add_type_constraint()} qr/not a valid type constraint/, '->add_type_constraint(undef) throws'; +throws_ok {$r->add_type_constraint('foo')} qr/not a valid type constraint/, '->add_type_constraint("foo") throws'; +throws_ok {$r->add_type_constraint(bless {}, 'SomeClass')} qr/not a valid type constraint/, '->add_type_constraint(SomeClass->new) throws'; +