added to coerce moose compat test case
大沢 和宏 [Tue, 2 Dec 2008 15:44:06 +0000 (15:44 +0000)]
t/501_moose_coerce_mouse.t [new file with mode: 0644]

diff --git a/t/501_moose_coerce_mouse.t b/t/501_moose_coerce_mouse.t
new file mode 100644 (file)
index 0000000..68c420f
--- /dev/null
@@ -0,0 +1,53 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More;
+use t::Exception;
+BEGIN {
+    plan skip_all => "Moose required for this test" unless eval { require Moose  && Moose->VERSION('0.59') };
+    plan tests => 5;
+}
+
+use t::Exception;
+
+{
+    package Headers;
+    use Mouse;
+    has 'foo' => ( is => 'rw' );
+}
+{
+    package Response;
+    use Mouse;
+    use Mouse::TypeRegistry;
+
+    subtype 'HeadersType' => sub { defined $_ && eval { $_->isa('Headers') } };
+    coerce 'HeadersType' => +{
+        HashRef => sub {
+            Headers->new(%{ $_ });
+        },
+    };
+
+    has headers => (
+        is     => 'rw',
+        isa    => 'HeadersType',
+        coerce => 1,
+    );
+}
+{
+    package Mosponse;
+    use Moose;
+    extends qw(Response);
+    ::lives_ok { extends qw(Response) } "extend Mouse class with Moose";
+}
+
+{
+    my $r = Mosponse->new(headers => { foo => 'bar' });
+    local our $TODO = "Moose not yet aware of Mouse meta";
+    isa_ok($r->headers, 'Headers');
+    is(eval{$r->headers->foo}, 'bar');
+    $r->headers({foo => 'yay'});
+    isa_ok($r->headers, 'Headers');
+    is($r->headers->foo, 'yay');
+}