X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2F900_bug%2F001_immutable_types.t;h=b3950e257321ec76421813a599cdf6b15ee0ab41;hb=5644cfbb90812c441c4c41266c526a38bea0e19a;hp=96a82b5d0025af7fd1d505e5d71a7556f974f4a6;hpb=86b99892e77319cf2f046f4563e0717f4005851d;p=gitmo%2FMouse.git diff --git a/t/900_bug/001_immutable_types.t b/t/900_bug/001_immutable_types.t index 96a82b5..b3950e2 100644 --- a/t/900_bug/001_immutable_types.t +++ b/t/900_bug/001_immutable_types.t @@ -1,9 +1,9 @@ use strict; use warnings; -use Test::More tests => 2; +use Test::More tests => 4; use Mouse::Util::TypeConstraints; -subtype 'Foo', where => sub { $_->isa('A') }; +subtype 'Foo', as 'Object', where { $_->isa('A') }; { package A; @@ -12,12 +12,56 @@ subtype 'Foo', where => sub { $_->isa('A') }; } { - package B; + package C; use Mouse; has a => ( is => 'rw', isa => 'Foo', coerce => 1 ); } -isa_ok(B->new(a => A->new()), 'B'); -B->meta->make_immutable; -isa_ok(B->new(a => A->new()), 'B'); +isa_ok(C->new(a => A->new()), 'C'); +C->meta->make_immutable; +isa_ok(C->new(a => A->new()), 'C'); + + + +# The BUILD invocation order used to get reversed after +# making a class immutable. This checks it is correct. +{ + package D; + use Mouse; + + # we'll keep + has order => + (is => 'ro', + default => sub {[]}); + + sub BUILD { push @{shift->order}, 'D' } + + package E; + use Mouse; + extends 'D'; + + sub BUILD { push @{shift->order}, 'E' } + + package F; + use Mouse; + extends 'E'; + + sub BUILD { push @{shift->order}, 'F' } + + +} + +my $obj = F->new; + +print join(", ", @{$obj->order}),"\n"; +is_deeply $obj->order, [qw(D E F)], "mutable BUILD invocation order correct"; + +# now make the classes immutable +$_->meta->make_immutable for qw(D E F); + +my $obj2 = F->new; + +print join(", ", @{$obj2->order}),"\n"; +is_deeply $obj2->order, [qw(D E F)], "immutable BUILD invocation order still correct"; +