From: Tokuhiro Matsuno 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'); +}