From: gfx Date: Tue, 22 Sep 2009 08:22:48 +0000 (+0900) Subject: Add a test file X-Git-Tag: 0.32~1 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=02eb9dec2f1c9fffd208999a210e530d93db07d1;p=gitmo%2FMouse.git Add a test file --- diff --git a/t/200_examples/0071_Child_Parent_attr_inherit_imm.t b/t/200_examples/0071_Child_Parent_attr_inherit_imm.t new file mode 100644 index 0000000..4a5a3bd --- /dev/null +++ b/t/200_examples/0071_Child_Parent_attr_inherit_imm.t @@ -0,0 +1,137 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More tests => 23; + +=pod + +Some examples of triggers and how they can +be used to manage parent-child relationships. + +=cut + +{ + + package Parent; + use Mouse; + + has 'last_name' => ( + is => 'rw', + isa => 'Str', + trigger => sub { + my $self = shift; + + # if the parents last-name changes + # then so do all the childrens + foreach my $child ( @{ $self->children } ) { + $child->last_name( $self->last_name ); + } + } + ); + + has 'children' => + ( is => 'rw', isa => 'ArrayRef', default => sub { [] } ); + __PACKAGE__->meta->make_immutable(); +} +{ + + package Child; + use Mouse; + + has 'parent' => ( + is => 'rw', + isa => 'Parent', + required => 1, + trigger => sub { + my $self = shift; + + # if the parent is changed,.. + # make sure we update + $self->last_name( $self->parent->last_name ); + } + ); + + has 'last_name' => ( + is => 'rw', + isa => 'Str', + lazy => 1, + default => sub { (shift)->parent->last_name } + ); + __PACKAGE__->meta->make_immutable(); +} + +my $parent = Parent->new( last_name => 'Smith' ); +isa_ok( $parent, 'Parent' ); + +is( $parent->last_name, 'Smith', + '... the parent has the last name we expected' ); + +$parent->children( [ map { Child->new( parent => $parent ) } ( 0 .. 3 ) ] ); + +foreach my $child ( @{ $parent->children } ) { + is( $child->last_name, $parent->last_name, + '... parent and child have the same last name (' + . $parent->last_name + . ')' ); +} + +$parent->last_name('Jones'); +is( $parent->last_name, 'Jones', '... the parent has the new last name' ); + +foreach my $child ( @{ $parent->children } ) { + is( $child->last_name, $parent->last_name, + '... parent and child have the same last name (' + . $parent->last_name + . ')' ); +} + +# make a new parent + +my $parent2 = Parent->new( last_name => 'Brown' ); +isa_ok( $parent2, 'Parent' ); + +# orphan the child + +my $orphan = pop @{ $parent->children }; + +# and then the new parent adopts it + +$orphan->parent($parent2); + +foreach my $child ( @{ $parent->children } ) { + is( $child->last_name, $parent->last_name, + '... parent and child have the same last name (' + . $parent->last_name + . ')' ); +} + +isnt( $orphan->last_name, $parent->last_name, + '... the orphan child does not have the same last name anymore (' + . $parent2->last_name + . ')' ); +is( $orphan->last_name, $parent2->last_name, + '... parent2 and orphan child have the same last name (' + . $parent2->last_name + . ')' ); + +# make sure that changes still will not propagate + +$parent->last_name('Miller'); +is( $parent->last_name, 'Miller', + '... the parent has the new last name (again)' ); + +foreach my $child ( @{ $parent->children } ) { + is( $child->last_name, $parent->last_name, + '... parent and child have the same last name (' + . $parent->last_name + . ')' ); +} + +isnt( $orphan->last_name, $parent->last_name, + '... the orphan child is not affected by changes in the parent anymore' ); +is( $orphan->last_name, $parent2->last_name, + '... parent2 and orphan child have the same last name (' + . $parent2->last_name + . ')' );