# -*- perl -*- # Attribute inheritance processing. use strict; use warnings; use Test; use Games::Object qw(ATTR_STATIC ATTR_NO_INHERIT FLAG_NO_INHERIT); use Games::Object::Manager; BEGIN { $| = 1; plan tests => 46 } # Create two objects and parent one to the other. my $man = Games::Object::Manager->new(); my $pobj = Games::Object->new(-id => "ParentObject"); ok( $pobj ); my $cobj = Games::Object->new(-id => "ChildObject"); ok( $cobj ); $man->add($pobj); $man->add($cobj); eval('$man->inherit($pobj, $cobj)'); ok( $@ eq '' ); print "# DEBUG: \$@ = $@" if ($@); my $test = $man->inheriting_from($cobj); ok( ref($test) eq 'Games::Object' && $test->id() eq $pobj->id() ); # Create some attributes and flags on the parent. eval('$pobj->new_attr( -name => "FeelFree", -type => "int", -value => 10)'); ok( $@ eq '' ); eval('$pobj->new_flag( -name => "FlagFeelFree", -value => 1)'); ok( $@ eq '' ); print "# DEBUG: \$@ = $@" if ($@); eval('$pobj->new_attr( -name => "CantTouchThis", -type => "int", -flags => ATTR_STATIC, -value => 20)'); ok( $@ eq '' ); print "# DEBUG: \$@ = $@" if ($@); eval('$pobj->new_attr( -name => "MineMineMine", -type => "int", -flags => ATTR_NO_INHERIT, -value => 30)'); ok( $@ eq '' ); print "# DEBUG: \$@ = $@" if ($@); eval('$pobj->new_attr( -name => "FlagMineMineMine", -flags => FLAG_NO_INHERIT, -value => 1)'); ok( $@ eq '' ); print "# DEBUG: \$@ = $@" if ($@); # All but the last should appear to exist on the child. ok( $cobj->attr_exists("FeelFree") ); ok( $cobj->attr_exists("CantTouchThis") ); ok( !$cobj->attr_exists("MineMineMine") ); # Should be able to see the first flag but not the second ok( $cobj->is("FlagFeelFree") ); ok( !$cobj->is("FlagMineMineMine") ); # And they should report proper values from the child. ok( $cobj->attr("FeelFree") == 10 ); ok( $cobj->attr("CantTouchThis") == 20 ); ok( !defined($cobj->attr("MineMineMine")) ); # And none should be shown to actually physically exist on the child. ok( !$cobj->attr_exists_here("FeelFree") ); ok( !$cobj->attr_exists_here("CantTouchThis") ); ok( !$cobj->attr_exists_here("MineMineMine") ); # Clear flag on parent. Child should now report it cleared. eval('$pobj->clear("FlagFeelFree")'); ok( $@ eq '' ); print "# DEBUG: \$@ = $@" if ($@); ok( !$cobj->is("FlagFeelFree") ); # Put a modifier on one of the attributes for the parent and process it. We # should see the new value from the child. It should still exist only # "superficially" on the child. eval('$pobj->mod_attr( -name => "FeelFree", -modify => 1, -incremental => 1, -persist_as => "FeelFreeMod")'); ok( $@ eq '' ); print "# DEBUG: \$@ = $@" if ($@); $pobj->process(); ok( $cobj->attr("FeelFree") == 11 ); ok( $cobj->attr_exists("FeelFree") ); ok( !$cobj->attr_exists_here("FeelFree") ); # Modify the same attribute on the child. We should see the new value on the # child and continue to see the old value on the parent. It should now REALLY # exist on the child. eval('$cobj->mod_attr( -name => "FeelFree", -modify => 5)'); ok( $@ eq '' ); print "# DEBUG: \$@ = $@" if ($@); ok( $cobj->attr("FeelFree") == 16 ); ok( $pobj->attr("FeelFree") == 11 ); ok( $cobj->attr_exists("FeelFree") ); ok( $cobj->attr_exists_here("FeelFree") ); # Process the parent object. It should change, child attribute should not. $pobj->process(); ok( $cobj->attr("FeelFree") == 16 ); ok( $pobj->attr("FeelFree") == 12 ); # Create a third object, make it the child of the child. It should see # FeelFree from the child, CantTouchThis from the parent, and MineMineMine # not at all. my $gobj = Games::Object->new(-id => "GrandChildObject"); $man->add($gobj); ok( $gobj ); eval('$man->inherit($cobj, $gobj)'); ok( $@ eq '' ); print "# DEBUG: \$@ = $@" if ($@); ok( $gobj->attr("FeelFree") == 16 ); ok( $gobj->attr("CantTouchThis") == 20 ); ok( !defined($gobj->attr("MineMineMine")) ); # Delete the attribute from the child. We should again see the parent attribute. eval('$cobj->del_attr("FeelFree")'); ok( $@ eq '' ); print "# DEBUG: \$@ = $@" if ($@); ok( $cobj->attr("FeelFree") == 12 ); ok( $cobj->attr_exists("FeelFree") ); ok( !$cobj->attr_exists_here("FeelFree") ); # And the grandchild should see it too. ok( $gobj->attr("FeelFree") == 12 ); # An attempt to set the static, inherited attribute should fail. eval('$cobj->mod_attr( -name => "CantTouchThis", -modify => 5)'); ok( $@ =~ /attempt to modify static/i ); eval('$gobj->mod_attr( -name => "CantTouchThis", -modify => 5)'); ok( $@ =~ /attempt to modify static/i ); # Save this test for last, since if it fails, other tests may cause # infinite loops. Make sure we can't incur a circular parent list. eval('$man->inherit($gobj, $pobj)'); ok( $@ =~ /Relating ParentObject to GrandChildObject in manner inherit would create a circular relationship/i );