test for the metaroles of metaroles thing (ruoso)
Jesse Luehrs [Wed, 24 Nov 2010 20:57:15 +0000 (14:57 -0600)]
t/050_metaclasses/070_metaroles_of_metaroles.t [new file with mode: 0755]

diff --git a/t/050_metaclasses/070_metaroles_of_metaroles.t b/t/050_metaclasses/070_metaroles_of_metaroles.t
new file mode 100755 (executable)
index 0000000..cf2457c
--- /dev/null
@@ -0,0 +1,68 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use Test::More;
+use Test::Fatal;
+
+{
+    package ApplicationMetaRole;
+    use Moose::Role;
+    use Moose::Util::MetaRole;
+
+    after apply => sub {
+        my ($self, $role_source, $role_dest, $args) = @_;
+        Moose::Util::MetaRole::apply_metaroles
+        (
+            for            => $role_dest,
+            role_metaroles =>
+            {
+                application_to_role => ['ApplicationMetaRole'],
+            }
+        );
+    };
+}
+{
+    package MyMetaRole;
+    use Moose::Role;
+    use Moose::Util::MetaRole;
+    use Moose::Exporter;
+
+    Moose::Exporter->setup_import_methods(also => q<Moose::Role>);
+
+    sub init_meta {
+        my ($class, %opts) = @_;
+        Moose::Role->init_meta(%opts);
+        Moose::Util::MetaRole::apply_metaroles
+        (
+            for            => $opts{for_class},
+            role_metaroles =>
+            {
+                application_to_role => ['ApplicationMetaRole'],
+            }
+        );
+        return $opts{for_class}->meta();
+    };
+}
+
+{
+    package MyRole;
+    use Moose::Role;
+
+    MyMetaRole->import;
+
+    use Moose::Util::TypeConstraints;
+
+    has schema => (
+        is     => 'ro',
+        coerce => 1,
+    );
+}
+
+{
+    package MyTargetRole;
+    use Moose::Role;
+    ::is(::exception { with "MyRole" }, undef,
+         "apply a meta role to a role, which is then applied to yet another role");
+}
+
+done_testing;