Changelogging

[gitmo/Mouse.git] / t / 100_with_moose / 500_moose_extends_mouse.t

diff --git a/t/100_with_moose/500_moose_extends_mouse.t b/t/100_with_moose/500_moose_extends_mouse.t
new file mode 100644 (file)
index 0000000..30b6de2
--- /dev/null
+++ b/t/100_with_moose/500_moose_extends_mouse.t
@@ -0,0 +1,124 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More;
+
+use Mouse::Spec;
+BEGIN {
+    eval{ require Moose && Moose->VERSION(Mouse::Spec->MooseVersion) };
+    plan skip_all => "Moose $Mouse::Spec::MooseVersion required for this test" if $@;
+    plan tests => 27;
+}
+
+use Test::Exception;
+
+{
+    package Foo;
+    use Mouse;
+
+    has foo => (
+        isa => "Int",
+        is  => "rw",
+    );
+
+    package Bar;
+    use Moose;
+
+    ::lives_ok { extends qw(Foo) } "extend Mouse class with Moose";
+
+    ::lives_ok {
+        has bar => (
+            isa => "Str",
+            is  => "rw",
+        );
+    } "new attr in subclass";
+
+    package Gorch;
+    use Moose;
+
+    ::lives_ok { extends qw(Foo) } "extend Mouse class with Moose";
+
+    {
+        local our $TODO = "Moose not yet aware of Mouse meta";
+        ::lives_ok {
+            has '+foo' => (
+                default => 3,
+            );
+        } "clone and inherit attr in subclass";
+    }
+
+    package Quxx;
+    use Mouse;
+
+    has quxx => (
+        is => "rw",
+        default => "lala",
+    );
+
+    package Zork;
+    use Moose;
+
+    ::lives_ok { extends qw(Quxx) } "extend Mouse class with Moose";
+
+    has zork => (
+        is => "rw",
+        default => 42,
+    );
+}
+
+can_ok( Bar => "new" );
+
+my $bar = eval { Bar->new };
+
+ok( $bar, "got an object" );
+isa_ok( $bar, "Bar" );
+isa_ok( $bar, "Foo" );
+
+can_ok( $bar, qw(foo bar) );
+
+is( eval { $bar->foo }, undef, "no default value" );
+is( eval { $bar->bar }, undef, "no default value" );
+
+{
+    local $TODO = "Moose not yet aware of Mouse meta";
+
+    is_deeply(
+        [ sort map { $_->name } Bar->meta->get_all_attributes ],
+        [ sort qw(foo bar) ],
+        "attributes",
+    );
+
+    is( eval { Gorch->new->foo }, 3, "cloned and inherited attr's default" );
+}
+
+can_ok( Zork => "new" );
+
+{
+    my $zork = eval { Zork->new };
+
+    ok( $zork, "got an object" );
+    isa_ok( $zork, "Zork" );
+    isa_ok( $zork, "Quxx" );
+
+    can_ok( $zork, qw(quxx zork) );
+
+    local $TODO = "Constructor needs to know default values of attrs from both";
+    is( eval { $bar->quxx }, "lala", "default value" );
+    is( eval { $bar->zork }, 42,     "default value" );
+}
+
+{
+    my $zork = eval { Zork->new( zork => "diff", quxx => "blah" ) };
+
+    ok( $zork, "got an object" );
+    isa_ok( $zork, "Zork" );
+    isa_ok( $zork, "Quxx" );
+
+    can_ok( $zork, qw(quxx zork) );
+
+    local $TODO = "Constructor needs to know init args of attrs from both";
+    is( eval { $bar->quxx }, "blah", "constructor param" );
+    is( eval { $bar->zork }, "diff", "constructor param" );
+}