Moose-2.1405HEADMoose-2.1405master

1 files changed, 158 insertions, 0 deletions

diff --git a/t/basics/moose_object_does.t b/t/basics/moose_object_does.t
new file mode 100644
index 0000000..87338af
--- /dev/null
+++ b/t/basics/moose_object_does.t
@@ -0,0 +1,158 @@
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Moose;
+
+{
+    package Role::A;
+    use Moose::Role
+}
+
+{
+    package Role::B;
+    use Moose::Role
+}
+
+{
+    package Foo;
+    use Moose;
+}
+
+{
+    package Bar;
+    use Moose;
+
+    with 'Role::A';
+}
+
+{
+    package Baz;
+    use Moose;
+
+    with qw( Role::A Role::B );
+}
+
+{
+    package Foo::Child;
+    use Moose;
+
+    extends 'Foo';
+}
+
+{
+    package Bar::Child;
+    use Moose;
+
+    extends 'Bar';
+}
+
+{
+    package Baz::Child;
+    use Moose;
+
+    extends 'Baz';
+}
+
+with_immutable {
+
+    for my $thing ( 'Foo', Foo->new, 'Foo::Child', Foo::Child->new ) {
+        my $name = ref $thing ? (ref $thing) . ' object' : "$thing class";
+        $name .= ' (immutable)' if $thing->meta->is_immutable;
+
+        ok(
+            !$thing->does('Role::A'),
+            "$name does not do Role::A"
+        );
+        ok(
+            !$thing->does('Role::B'),
+            "$name does not do Role::B"
+        );
+
+        ok(
+            !$thing->does( Role::A->meta ),
+            "$name does not do Role::A (passed as object)"
+        );
+        ok(
+            !$thing->does( Role::B->meta ),
+            "$name does not do Role::B (passed as object)"
+        );
+
+        ok(
+            !$thing->DOES('Role::A'),
+            "$name does not do Role::A (using DOES)"
+        );
+        ok(
+            !$thing->DOES('Role::B'),
+            "$name does not do Role::B (using DOES)"
+        );
+    }
+
+    for my $thing ( 'Bar', Bar->new, 'Bar::Child', Bar::Child->new ) {
+        my $name = ref $thing ? (ref $thing) . ' object' : "$thing class";
+        $name .= ' (immutable)' if $thing->meta->is_immutable;
+
+        ok(
+            $thing->does('Role::A'),
+            "$name does Role::A"
+        );
+        ok(
+            !$thing->does('Role::B'),
+            "$name does not do Role::B"
+        );
+
+        ok(
+            $thing->does( Role::A->meta ),
+            "$name does Role::A (passed as object)"
+        );
+        ok(
+            !$thing->does( Role::B->meta ),
+            "$name does not do Role::B (passed as object)"
+        );
+
+        ok(
+            $thing->DOES('Role::A'),
+            "$name does Role::A (using DOES)"
+        );
+        ok(
+            !$thing->DOES('Role::B'),
+            "$name does not do Role::B (using DOES)"
+        );
+    }
+
+    for my $thing ( 'Baz', Baz->new, 'Baz::Child', Baz::Child->new ) {
+        my $name = ref $thing ? (ref $thing) . ' object' : "$thing class";
+        $name .= ' (immutable)' if $thing->meta->is_immutable;
+
+        ok(
+            $thing->does('Role::A'),
+            "$name does Role::A"
+        );
+        ok(
+            $thing->does('Role::B'),
+            "$name does Role::B"
+        );
+
+        ok(
+            $thing->does( Role::A->meta ),
+            "$name does Role::A (passed as object)"
+        );
+        ok(
+            $thing->does( Role::B->meta ),
+            "$name does Role::B (passed as object)"
+        );
+
+        ok(
+            $thing->DOES('Role::A'),
+            "$name does Role::A (using DOES)"
+        );
+        ok(
+            $thing->DOES('Role::B'),
+            "$name does Role::B (using DOES)"
+        );
+    }
+
+}
+qw( Foo Bar Baz Foo::Child Bar::Child Baz::Child );
+
+done_testing;