From: Tomas Doran <bobtfish@bobtfish.net>
Date: Tue, 7 Oct 2008 17:13:51 +0000 (+0000)
Subject: More type constraint fixes for edge cases in is_a_type_of and is_a_subtype_of when... 
X-Git-Tag: 0.59~15
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=4c015454152fff7c0a2c71665d4dc5e0f39b835b;p=gitmo%2FMoose.git

More type constraint fixes for edge cases in is_a_type_of and is_a_subtype_of when dealing with unknown type names + tests for all possible cases (I think)
---

diff --git a/Changes b/Changes
index c783632..15a9b06 100644
--- a/Changes
+++ b/Changes
@@ -17,10 +17,18 @@ Revision history for Perl extension Moose
         Rolsky)
       - Test firing behavior of triggers in relation to builder/default/
         lazy_build. (t0m)
+      - Test behavior of equals/is_a_type_of/is_a_subtype_of for all
+        kinds of supported type. (t0m)
     * Moose::Meta::Class
       - In create(), do not pass "roles" option to the superclass
         - added related test that creates an anon metaclass with
           a required attribute
+    * Moose::Meta::TypeConstraint::Class
+    * Moose::Meta::TypeConstraint::Role
+      - Unify behavior of equals/is_a_type_of/is_a_subtype_of with
+        other types (as per change in 0.55_02). (t0m)
+    * Moose::Meta::TypeConstraint::Registry
+      - Fix warning when dealing with unknown type names (t0m)
 
 0.58 Sat September 20, 2008
     !! This release has an incompatible change regarding !!
diff --git a/lib/Moose/Meta/TypeConstraint/Class.pm b/lib/Moose/Meta/TypeConstraint/Class.pm
index 888d1ae..4d63b09 100644
--- a/lib/Moose/Meta/TypeConstraint/Class.pm
+++ b/lib/Moose/Meta/TypeConstraint/Class.pm
@@ -61,6 +61,7 @@ sub equals {
 
     my $other = Moose::Util::TypeConstraints::find_type_constraint($type_or_name);
 
+    return unless defined $other;
     return unless $other->isa(__PACKAGE__);
 
     return $self->class eq $other->class;
@@ -83,6 +84,8 @@ sub is_subtype_of {
     }
 
     my $type = Moose::Util::TypeConstraints::find_type_constraint($type_or_name_or_class);
+    
+    return unless defined $type;
 
     if ( $type->isa(__PACKAGE__) ) {
         # if $type_or_name_or_class isn't a class, it might be the TC name of another ::Class type
diff --git a/lib/Moose/Meta/TypeConstraint/Registry.pm b/lib/Moose/Meta/TypeConstraint/Registry.pm
index d959632..ff2157c 100644
--- a/lib/Moose/Meta/TypeConstraint/Registry.pm
+++ b/lib/Moose/Meta/TypeConstraint/Registry.pm
@@ -33,7 +33,7 @@ sub new {
 
 sub has_type_constraint {
     my ($self, $type_name) = @_;
-    exists $self->type_constraints->{$type_name} ? 1 : 0
+    ($type_name and exists $self->type_constraints->{$type_name}) ? 1 : 0
 }
 
 sub get_type_constraint {
diff --git a/lib/Moose/Meta/TypeConstraint/Role.pm b/lib/Moose/Meta/TypeConstraint/Role.pm
index dc5029c..d3caecc 100644
--- a/lib/Moose/Meta/TypeConstraint/Role.pm
+++ b/lib/Moose/Meta/TypeConstraint/Role.pm
@@ -59,6 +59,7 @@ sub equals {
 
     my $other = Moose::Util::TypeConstraints::find_type_constraint($type_or_name);
 
+    return unless defined $other;
     return unless $other->isa(__PACKAGE__);
 
     return $self->role eq $other->role;
@@ -82,6 +83,8 @@ sub is_subtype_of {
 
     my $type = Moose::Util::TypeConstraints::find_type_constraint($type_or_name_or_role);
 
+    return unless defined $type;
+    
     if ( $type->isa(__PACKAGE__) ) {
         # if $type_or_name_or_role isn't a role, it might be the TC name of another ::Role type
         # or it could also just be a type object in this branch
diff --git a/t/040_type_constraints/008_union_types.t b/t/040_type_constraints/008_union_types.t
index 16227bc..5c84661 100644
--- a/t/040_type_constraints/008_union_types.t
+++ b/t/040_type_constraints/008_union_types.t
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 33;
+use Test::More tests => 35;
 use Test::Exception;
 
 BEGIN {
@@ -35,6 +35,9 @@ ok( $Str_or_Undef->equals($Str_or_Undef), "equal to self" );
 ok( $Str_or_Undef->equals(Moose::Meta::TypeConstraint::Union->new(type_constraints => [ $Str, $Undef ])), "equal to clone" );
 ok( $Str_or_Undef->equals(Moose::Meta::TypeConstraint::Union->new(type_constraints => [ $Undef, $Str ])), "equal to reversed clone" );
 
+ok( !$Str_or_Undef->is_a_type_of("ThisTypeDoesNotExist"), "not type of non existant type" );
+ok( !$Str_or_Undef->is_subtype_of("ThisTypeDoesNotExist"), "not subtype of non existant type" );
+
 # another ....
 
 my $ArrayRef = find_type_constraint('ArrayRef');
diff --git a/t/040_type_constraints/015_enum.t b/t/040_type_constraints/015_enum.t
index 2aebf75..162905e 100644
--- a/t/040_type_constraints/015_enum.t
+++ b/t/040_type_constraints/015_enum.t
@@ -31,7 +31,7 @@ push @invalid_metacharacters, '^1?$|^(11+?)\1+$';
 plan tests => @valid_letters        + @invalid_letters
             + @valid_languages      + @invalid_languages
             + @valid_metacharacters + @invalid_metacharacters
-            + @valid_languages      + 6;
+            + @valid_languages      + 10;
 
 Moose::Util::TypeConstraints->export_type_constraints_as_functions();
 
@@ -59,3 +59,10 @@ ok($anon_enum->check($_), "'$_' is a language") for @valid_languages;
 ok( !$anon_enum->equals( enum [qw(foo bar)] ), "doesn't equal a diff enum" );
 ok( $anon_enum->equals( $anon_enum ), "equals itself" );
 ok( $anon_enum->equals( enum \@valid_languages ), "equals duplicate" );
+
+ok( !$anon_enum->is_subtype_of('Object'), 'enum not a subtype of Object');
+ok( !$anon_enum->is_a_type_of('Object'), 'enum not type of Object');
+
+ok( !$anon_enum->is_subtype_of('ThisTypeDoesNotExist'), 'enum not a subtype of nonexistant type');
+ok( !$anon_enum->is_a_type_of('ThisTypeDoesNotExist'), 'enum not type of nonexistant type');
+
diff --git a/t/040_type_constraints/016_subtyping_parameterized_types.t b/t/040_type_constraints/016_subtyping_parameterized_types.t
index 221cf6a..444b18a 100644
--- a/t/040_type_constraints/016_subtyping_parameterized_types.t
+++ b/t/040_type_constraints/016_subtyping_parameterized_types.t
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 30;
+use Test::More tests => 32;
 use Test::Exception;
 
 BEGIN {
@@ -32,6 +32,9 @@ lives_ok {
     ok( $t->equals($t), "equals to self" );
     ok( !$t->equals( $t->parent ), "not equal to parent" );
     ok( $t->parent->equals( $t->parent ), "parent equals to self" );
+
+    ok( !$t->is_a_type_of("ThisTypeDoesNotExist"), "not a non existant type" );
+    ok( !$t->is_subtype_of("ThisTypeDoesNotExist"), "not a subtype of a non existant type" );
 }
 
 lives_ok {
diff --git a/t/040_type_constraints/020_class_type_constraint.t b/t/040_type_constraints/020_class_type_constraint.t
index 5eac4e9..ec6bd50 100644
--- a/t/040_type_constraints/020_class_type_constraint.t
+++ b/t/040_type_constraints/020_class_type_constraint.t
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 18;
+use Test::More tests => 20;
 use Test::Exception;
 
 BEGIN {
@@ -38,6 +38,9 @@ ok( $type->is_subtype_of("Bar"), "subtype of bar" );
 
 ok( $type->is_subtype_of("Object"), "subtype of Object" );
 
+ok( !$type->is_subtype_of("ThisTypeDoesNotExist"), "not subtype of undefined type" );
+ok( !$type->is_a_type_of("ThisTypeDoesNotExist"), "not type of undefined type" );
+
 ok( find_type_constraint("Bar")->check(Foo->new), "Foo passes Bar" );
 ok( find_type_constraint("Bar")->check(Bar->new), "Bar passes Bar" );
 ok( !find_type_constraint("Gorch")->check(Bar->new), "but Bar doesn't pass Gorch");
diff --git a/t/040_type_constraints/024_role_type_constraint.t b/t/040_type_constraints/024_role_type_constraint.t
index fca6e75..f20f68d 100644
--- a/t/040_type_constraints/024_role_type_constraint.t
+++ b/t/040_type_constraints/024_role_type_constraint.t
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 17;
+use Test::More tests => 19;
 use Test::Exception;
 
 BEGIN {
@@ -46,6 +46,9 @@ ok( $type->is_subtype_of("Bar"), "subtype of bar" );
 ok( $type->is_subtype_of("Object"), "subtype of Object" );
 ok( $type->is_subtype_of("Role"), "subtype of Role" );
 
+ok( !$type->is_subtype_of("ThisTypeDoesNotExist"), "not subtype of unknown type name" );
+ok( !$type->is_a_type_of("ThisTypeDoesNotExist"), "not type of unknown type name" );
+
 ok( find_type_constraint("Bar")->check(FooC->new), "Foo passes Bar" );
 ok( find_type_constraint("Bar")->check(BarC->new), "Bar passes Bar" );
 ok( !find_type_constraint("Gorch")->check(BarC->new), "but Bar doesn't pass Gorch");