From: Tokuhiro Matsuno <tokuhirom@gp.ath.cx>
Date: Sun, 7 Dec 2008 11:29:32 +0000 (+0000)
Subject: added more test cases
X-Git-Tag: 0.19~136^2~7
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=7ef693408333b817259bb2db3504668d724feaab;p=gitmo%2FMouse.git

added more test cases
---

diff --git a/t/800_shikabased/003-make_immutable.t b/t/800_shikabased/003-make_immutable.t
index 28ebaff..d1539b4 100644
--- a/t/800_shikabased/003-make_immutable.t
+++ b/t/800_shikabased/003-make_immutable.t
@@ -1,34 +1,85 @@
 use strict;
 use warnings;
-use Test::More tests => 6;
+use Test::More tests => 18;
 use Test::Exception;
+use Scalar::Util qw/isweak/;
 
 {
-    package HardDog;
+    package Headers;
     use Mouse;
-    has bone => (
+    has data => (
         is => 'rw',
-        required => 1,
+        isa => 'Str',
     );
-    sub BUILD { main::ok "calling BUILD in HardDog" }
     no Mouse;
-    __PACKAGE__->meta->make_immutable;
 }
 
 {
-    package SoftDog;
+    package Types;
+    use MouseX::Types -declare => [qw/Foo/];
+    use MouseX::Types::Mouse 'HashRef';
+    class_type Foo, { class => 'Headers' };
+    coerce Foo,
+        from HashRef,
+        via {
+        Headers->new($_);
+    };
+}
+
+
+&main; exit;
+
+sub construct {
+    my $class = shift;
+    eval <<"...";
+    package $class;
     use Mouse;
+    BEGIN { Types->import('Foo') }
     has bone => (
         is => 'rw',
         required => 1,
     );
+    has foo => (
+        is     => 'rw',
+        isa    => Foo,
+        coerce => 1,
+    );
+    has weak_foo => (
+        is       => 'rw',
+        weak_ref => 1,
+    );
+    has trigger_foo => (
+        is => 'rw',
+        trigger => sub { \$_[0]->bone('eat') },
+    );
     sub BUILD { main::ok "calling BUILD in SoftDog" }
     no Mouse;
+...
+    die $@ if $@;
 }
 
-lives_ok { SoftDog->new(bone => 'moo') };
-lives_ok { HardDog->new(bone => 'moo') };
+sub test {
+    my $class = shift;
+    lives_ok { $class->new(bone => 'moo') } "$class new";
+    throws_ok { $class->new() } qr/\QAttribute (bone) is required/;
+    is($class->new(bone => 'moo', foo => { data => 3 })->foo->data, 3);
 
-throws_ok { SoftDog->new() } qr/\QAttribute (bone) is required/;
-throws_ok { HardDog->new() } qr/\QAttribute (bone) is required/;
+    my $foo = Headers->new();
+    ok(Scalar::Util::isweak($class->new(bone => 'moo', weak_foo => $foo)->{weak_foo}));
+
+    {
+        my $o = $class->new(bone => 'moo');
+        $o->trigger_foo($foo);
+        is($o->bone, 'eat');
+    }
+}
+
+sub main {
+    construct('SoftDog');
+    test('SoftDog');
+
+    construct('HardDog');
+    HardDog->meta->make_immutable;
+    test('HardDog');
+}