X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2F800_shikabased%2F003-make_immutable.t;fp=t%2F800_shikabased%2F003-make_immutable.t;h=d1539b4eb4a74acec0fc0b6c86139b2f63ce038f;hb=7ef693408333b817259bb2db3504668d724feaab;hp=28ebaffc1ea6afda9759fa8196c770b54148f582;hpb=f2560fde38fb3827df7a380a5774e265b092a6fd;p=gitmo%2FMouse.git

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');
+}