From: Dagfinn Ilmari Mannsåker <ilmari@ilmari.org>
Date: Sat, 9 Feb 2013 17:50:08 +0000 (+0000)
Subject: Create class and role type constraints for Moose
X-Git-Tag: v1.001000~34
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=gitmo%2FMoo.git;a=commitdiff_plain;h=590745982a3ba20d42e45b9c1b4c40f72413f17a

Create class and role type constraints for Moose

Moose implicitly creates type constraints for roles and classes, which
means that isa => 'SomeRole' accepts an object that does the role.  For
increased compatibility, create these constraints when injecting the
fake meta class.
---

diff --git a/lib/Moo/HandleMoose.pm b/lib/Moo/HandleMoose.pm
index 21af12c..cb2c2a2 100644
--- a/lib/Moo/HandleMoose.pm
+++ b/lib/Moo/HandleMoose.pm
@@ -37,6 +37,12 @@ sub inject_fake_metaclass_for {
   Class::MOP::store_metaclass_by_name(
     $name, bless({ name => $name }, 'Moo::HandleMoose::FakeMetaClass')
   );
+  require Moose::Util::TypeConstraints;
+  if ($Moo::Role::INFO{$name}) {
+    Moose::Util::TypeConstraints::find_or_create_does_type_constraint($name);
+  } else {
+    Moose::Util::TypeConstraints::find_or_create_isa_type_constraint($name);
+  }
 }
 
 {
diff --git a/xt/implicit-moose-types.t b/xt/implicit-moose-types.t
new file mode 100644
index 0000000..037ea6c
--- /dev/null
+++ b/xt/implicit-moose-types.t
@@ -0,0 +1,32 @@
+use strictures 1;
+use Test::More;
+
+use Moose::Util::TypeConstraints qw(find_type_constraint);
+
+{
+  package TestRole;
+  use Moo::Role;
+}
+
+{
+  package TestClass;
+  use Moo;
+
+  with 'TestRole';
+}
+
+my $o = TestClass->new;
+
+foreach my $name (qw(TestClass TestRole)) {
+  ok !find_type_constraint($name), "No $name constraint created without Moose loaded";
+}
+note "Loading Moose";
+require Moose;
+
+foreach my $name (qw(TestClass TestRole)) {
+  my $tc = find_type_constraint($name);
+  isa_ok $tc, 'Moose::Meta::TypeConstraint', "$name constraint"
+    and ok $tc->check($o), "TestClass object passes $name constraint";
+}
+
+done_testing;