From: Scott McWhirter <konobi@cpan.org>
Date: Wed, 20 Feb 2008 03:29:57 +0000 (+0000)
Subject: Add ObjectOfType XS function for use with anon types constraints that
X-Git-Tag: 0_55~298
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=a4550ed1c56166a6a7ec26ae594f73140c3d77e3;p=gitmo%2FMoose.git

Add ObjectOfType XS function for use with anon types constraints that
are generated against classes.
---

diff --git a/Moose.xs b/Moose.xs
index ef7a8d9..a12e103 100644
--- a/Moose.xs
+++ b/Moose.xs
@@ -144,6 +144,29 @@ Object(value)
     RETVAL
 
 bool
+ObjectOfType(value, class)
+  SV* value
+  SV* class
+  PREINIT:
+    const char* classname;
+  CODE:
+    RETVAL = 0;
+
+    classname = SvPV_nolen(class);
+    if(!classname){
+      RETVAL = 0;  
+    }
+
+    if( ck_sv_is_ref(value) 
+        && sv_isobject(value)
+        && sv_derived_from(value, classname)
+      ){
+      RETVAL = 1;  
+    }
+  OUTPUT:
+    RETVAL
+
+bool
 RegexpRef(value)
   SV* value
   CODE:
diff --git a/lib/Moose/Meta/TypeConstraint/Class.pm b/lib/Moose/Meta/TypeConstraint/Class.pm
index a14ace5..7df0e78 100644
--- a/lib/Moose/Meta/TypeConstraint/Class.pm
+++ b/lib/Moose/Meta/TypeConstraint/Class.pm
@@ -39,7 +39,9 @@ sub parents {
 sub hand_optimized_type_constraint {
     my $self  = shift;
     my $class = $self->name;
-    sub { blessed( $_[0] ) && $_[0]->isa($class) }
+    sub {
+      Moose::Util::TypeConstraints::OptimizedConstraints::ObjectOfType($_[0], $class)
+    }
 }
 
 sub has_hand_optimized_type_constraint { 1 }
diff --git a/lib/Moose/Util/TypeConstraints/OptimizedConstraints.pm b/lib/Moose/Util/TypeConstraints/OptimizedConstraints.pm
index 80e13b7..0356f20 100644
--- a/lib/Moose/Util/TypeConstraints/OptimizedConstraints.pm
+++ b/lib/Moose/Util/TypeConstraints/OptimizedConstraints.pm
@@ -70,6 +70,10 @@ This file contains the hand optimized versions of Moose type constraints.
 
 =item Object
 
+=item ObjectOfType
+
+Makes sure $object->isa($class). Used in anon type constraints.
+
 =item Role
 
 =back