From: Florian Ragwitz <rafl@debian.org>
Date: Wed, 31 Mar 2010 23:03:55 +0000 (+0200)
Subject: Make Moose::Meta::TypeConstraint::Class correctly reject RegexpRefs.
X-Git-Tag: 1.02~18
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=e018ef42963899146ba9b3b2140cfdb2906d8ce5;p=gitmo%2FMoose.git

Make Moose::Meta::TypeConstraint::Class correctly reject RegexpRefs.
---

diff --git a/Changes b/Changes
index 9c88403..b15072a 100644
--- a/Changes
+++ b/Changes
@@ -1,6 +1,11 @@
 Also see Moose::Manual::Delta for more details of, and workarounds
 for, noteworthy changes.
 
+  [BUG FIXES]
+
+  * Make Moose::Meta::TypeConstraint::Class correctly reject RegexpRefs.
+    (Florian Ragwitz)
+
 1.01 Fri, Mar 26, 2010
 
   [NEW FEATURES]
diff --git a/lib/Moose/Meta/TypeConstraint/Class.pm b/lib/Moose/Meta/TypeConstraint/Class.pm
index b350fe5..397e3d9 100644
--- a/lib/Moose/Meta/TypeConstraint/Class.pm
+++ b/lib/Moose/Meta/TypeConstraint/Class.pm
@@ -34,7 +34,7 @@ sub _create_hand_optimized_type_constraint {
     my $class = $self->class;
     $self->hand_optimized_type_constraint(
         sub {
-            blessed( $_[0] ) && $_[0]->isa($class)
+            blessed( $_[0] ) && blessed( $_[0] ) ne 'Regexp' && $_[0]->isa($class)
         }
     );
 }
diff --git a/t/040_type_constraints/020_class_type_constraint.t b/t/040_type_constraints/020_class_type_constraint.t
index 64aff96..0ae1348 100644
--- a/t/040_type_constraints/020_class_type_constraint.t
+++ b/t/040_type_constraints/020_class_type_constraint.t
@@ -58,4 +58,9 @@ ok( $type->equals(Moose::Meta::TypeConstraint::Class->new( name => "Oink", class
 ok( !$type->equals(Moose::Meta::TypeConstraint::Class->new( name => "__ANON__", class => "Bar" )), "doesn't equal other anon constraint" );
 ok( $type->is_subtype_of(Moose::Meta::TypeConstraint::Class->new( name => "__ANON__", class => "Bar" )), "subtype of other anon constraint" );
 
+{
+    my $regexp_type = Moose::Meta::TypeConstraint::Class->new(name => 'Regexp', class => 'Regexp');
+    ok(!$regexp_type->check(qr//), 'a Regexp is not an instance of a class, even tho perl pretends it is');
+}
+
 done_testing;