From: Shawn M Moore Date: Tue, 10 Jun 2008 01:41:45 +0000 (+0000) Subject: Unknown type constraints are now interpreted as blessed($value) eq $type X-Git-Tag: 0.04~77 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=3301fa546394abbef62f5a7f9bbfc1c49ae6eb50;p=gitmo%2FMouse.git Unknown type constraints are now interpreted as blessed($value) eq $type --- diff --git a/lib/Mouse/Attribute.pm b/lib/Mouse/Attribute.pm index 1e60e21..bc897ab 100644 --- a/lib/Mouse/Attribute.pm +++ b/lib/Mouse/Attribute.pm @@ -4,6 +4,7 @@ use strict; use warnings; use Carp 'confess'; +use Scalar::Util 'blessed'; sub new { my $class = shift; @@ -197,7 +198,7 @@ sub find_type_constraint { my $checker = Mouse::TypeRegistry->optimized_constraints->{$type}; return $checker if $checker; - confess "Unable to parse type constraint '$type'"; + return sub { blessed($_) && blessed($_) eq $type }; } sub verify_type_constraint { diff --git a/t/025-more-isa.t b/t/025-more-isa.t new file mode 100644 index 0000000..a457fa7 --- /dev/null +++ b/t/025-more-isa.t @@ -0,0 +1,41 @@ +#!/usr/bin/env perl +use strict; +use warnings; +use Test::More tests => 7; +use Test::Exception; + +do { + package Class; + use Mouse; + + has tb => ( + is => 'rw', + isa => 'Test::Builder', + ); +}; + +can_ok(Class => 'tb'); + +lives_ok { + Class->new(tb => Test::Builder->new); +}; + +lives_ok { + my $class = Class->new; + $class->tb(Test::Builder->new); + isa_ok($class->tb, 'Test::Builder'); +}; + +throws_ok { + Class->new(tb => 3); +} qr/Attribute \(tb\) does not pass the type constraint because: Validation failed for 'Test::Builder' failed with value 3/; + +throws_ok { + my $class = Class->new; + $class->tb(3); +} qr/Attribute \(tb\) does not pass the type constraint because: Validation failed for 'Test::Builder' failed with value 3/; + +throws_ok { + Class->new(tb => Class->new); +} qr/Attribute \(tb\) does not pass the type constraint because: Validation failed for 'Test::Builder' failed with value Class=HASH\(\w+\)/; +