Create class and role type constraints for Moose
Dagfinn Ilmari Mannsåker [Sat, 9 Feb 2013 17:50:08 +0000 (17:50 +0000)]
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.

lib/Moo/HandleMoose.pm
xt/implicit-moose-types.t [new file with mode: 0644]

index 21af12c..cb2c2a2 100644 (file)
@@ -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 (file)
index 0000000..037ea6c
--- /dev/null
@@ -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;