#!/usr/bin/perl -w use strict; use Test::More tests => 629; BEGIN { # Don't use Class::XSAccessor unless invoked from t/makemethods-xs.t # as indicated by magic (false) value 0, set in t/makemethods-xs.t unless(defined $ENV{'ROSE_OBJECT_NO_CLASS_XSACCESOR'}) { $ENV{'ROSE_OBJECT_NO_CLASS_XSACCESOR'} = 1; } use_ok('Rose::Object'); use_ok('Rose::Object::MakeMethods::Generic'); use_ok('Rose::Class'); use_ok('Rose::Class::MakeMethods::Generic'); use_ok('Rose::Class::MakeMethods::Set'); } my $p = Person->new() || ok(0); ok(ref $p eq 'Person', 'Construct object (no init)'); ## ## Object methods ## # # scalar # is($p->bar, undef, 'Get named attribute (scalar)'); is($p->bar('bar'), 'bar', 'Set named attribute 1 (scalar)'); is($p->bar, 'bar', 'Set named attribute 2 (scalar)'); # # scalar --get_set_init # is($p->type, 'default', 'Get named attribute (scalar --get_set_init)'); $p->type('foo'); is($p->type, 'foo', 'Set named attribute (scalar --get_set_init)'); # # boolean # $p->is_foo('foo'); is($p->is_foo, 1, 'Set named attribute (boolean) 1'); $p->is_foo(''); is($p->is_foo, 0, 'Set named attribute (boolean) 2'); $p->is_foo(0); is($p->is_foo, 0, 'Set named attribute (boolean) 3'); is($p->is_valid, 1, 'Default value (boolean)'); is($p->def0, 0, 'Default value (0) (boolean)'); # # boolean --get_set_init # is($p->is_def_foo, 1, 'Get named attribute (boolean --get_set_init)'); $p->is_def_foo(undef); is($p->is_def_foo, 0, 'Set named attribute (boolean --get_set_init)'); # # hash # ok(!defined $p->params, 'Get undefinied hash (hash)'); $p->params(a => 1, b => 2); is($p->param('b'), 2, 'Get hash key (hash)'); my $h = $p->params; ok(ref $h eq 'HASH' && $h->{'a'} == 1 && $h->{'b'} == 2, 'Get hash ref (hash --get-set_all)'); my %h = $p->params; ok($h{'a'} == 1 && $h{'b'} == 2, 'Get hash (hash --get-set_all)'); $p->params({ c => 3, d => 4 }); ok(!$p->param_exists('a'), 'Check for key existence (hash --exists)'); is(join(',', sort $p->param_names), 'c,d', 'Get key names (hash --keys)'); is(join(',', sort $p->param_values), '3,4', 'Get key values (hash --values)'); $p->delete_param('c'); is(join(',', sort $p->param_names), 'd', 'Delete param (hash --delete)'); $p->param(f => 7, g => 8); is(join(',', sort $p->param_values), '4,7,8', 'Add name/value pairs (hash)'); # # hash --get_set_init_all # $h = $p->fhash; ok(ref $h eq 'HASH' && $h->{'a'} == 1 && $h->{'b'} == 2, 'Get hash ref (hash --get-get_set_init_all)'); %h = $p->fhash; ok($h{'a'} == 1 && $h{'b'} == 2, 'Get hash (hash --get-set_all)'); $p->fhash(c => 3, d => 4); $h = $p->fhash; ok(ref $h eq 'HASH' && $h->{'c'} == 3 && $h->{'d'} == 4, 'Get hash ref 2 (hash --get-get_set_init_all)'); %h = $p->fhash; ok($h{'c'} == 3 && $h{'d'} == 4, 'Get hash 2 (hash --get-set_all)'); $p->fhash({ e => 5, f => 6 }); $h = $p->fhash; ok(ref $h eq 'HASH' && $h->{'e'} == 5 && $h->{'f'} == 6, 'Get hash ref 3 (hash --get-get_set_init_all)'); %h = $p->fhash; ok($h{'e'} == 5 && $h{'f'} == 6, 'Get hash 3 (hash --get-set_all)'); # # hash --get_set_init # my $ip = $p->iparams; ok(ref $ip eq 'HASH' && $ip->{'a'} == 1 && $ip->{'b'} == 2, 'Get default hash - hash ref (hash --get_set_init)'); $p->iparams({ c => 3, d => 4 }); my %ip = $p->iparams; ok(keys %ip == 2 && $ip{'c'} == 3 && $ip{'d'} == 4, 'Set hash - hash ref (hash --get_set_init)'); $p->clear_iparams(); %ip = $p->iparams; ok(!keys %ip, 'Clear hash (hash --get_set_init)'); $p->reset_iparams(); %ip = $p->iparams; ok(keys %ip == 2 && $ip{'a'} == 1 && $ip{'b'} == 2, 'Get default hash - hash (hash --get_set_init)'); $p->iparams(c => 3, d => 4); $ip = $p->iparams; ok(ref $ip eq 'HASH' && $ip->{'c'} == 3 && $ip->{'d'} == 4, 'Set hash - hash (hash --get_set_inited)'); my $p2 = Person->new(); is($p2->iparams('b'), 2, 'Init on key request (hash --get_set_inited)'); # # hash --get_set_inited # $ip = $p->idparams; ok(ref $ip eq 'HASH' && !keys %$ip, 'Get empty hash - scalar (hash --get_set_inited)'); $p->idparams({ c => 3, d => 4 }); %ip = $p->idparams; ok(keys %ip == 2 && $ip{'c'} == 3 && $ip{'d'} == 4, 'Set hash - hash ref (hash --get_set_inited)'); $p->clear_idparams(); %ip = $p->idparams; ok(!keys %ip, 'Get empty hash - list (hash --get_set_inited)'); $p->idparams(c => 3, d => 4); $ip = $p->idparams; ok(ref $ip eq 'HASH' && $ip->{'c'} == 3 && $ip->{'d'} == 4, 'Set hash - hash (hash --get_set_inited)'); # # array # ok(!defined $p->jobs, 'Get undefined array (array)'); $p->clear_jobs(); ok(@{$p->jobs} == 0, 'Clear array (array)'); $p->jobs('butcher', 'baker'); is(join(',', $p->jobs), 'butcher,baker', 'Set list - array (array)'); $p->jobs([ 'butcher', 'baker' ]); is(join(',', $p->jobs), 'butcher,baker', 'Set list - array ref (array)'); is(join(',', @{$p->jobs}), 'butcher,baker', 'Get list - array ref (array)'); $p->push_jobs('x'); is(join(',', $p->jobs), 'butcher,baker,x', 'push 1(array)'); $p->push_jobs('y', 'z'); is(join(',', $p->jobs), 'butcher,baker,x,y,z', 'push 2 (array)'); is($p->pop_jobs, 'z', 'pop 1 (array)'); is(join(',', $p->jobs), 'butcher,baker,x,y', 'pop 2 (array)'); is(join(',', $p->pop_jobs(2)), 'x,y', 'pop 3 (array)'); is(join(',', $p->jobs), 'butcher,baker', 'pop 4 (array)'); $p->push_jobs([ 1, 2 ]); is(join(',', $p->jobs), 'butcher,baker,1,2', 'pop 5 (array)'); is(join(',', $p->pop_jobs(2)), '1,2', 'pop 6 (array)'); $p->unshift_jobs('a'); is(join(',', $p->jobs), 'a,butcher,baker', 'unshift 1 (array)'); $p->unshift_jobs('b', 'c'); is(join(',', $p->jobs), 'b,c,a,butcher,baker', 'unshift 2 (array)'); $p->unshift_jobs([ 'd', 'e' ]); is(join(',', $p->jobs), 'd,e,b,c,a,butcher,baker', 'unshift 3 (array)'); is($p->shift_jobs, 'd', 'shift 1 (array)'); is(join(',', $p->shift_jobs(4)), 'e,b,c,a', 'shift 2 (array)'); # # array --get_set_item # $p->jobs([ 'xbutcher', 'xbaker' ]); is($p->job(0), 'xbutcher', 'Get item by index (array --get_set_item)'); $p->job(0 => 'mailman'); is($p->job(0), 'mailman', 'Set item by index (array --get_set_item)'); # # array --get_set_init # is(join(',', $p->nicknames), 'wiley,joe', 'Get default list - array (array --get_set_init)'); $p->nicknames('sam', 'moe'); is(join(',', $p->nicknames), 'sam,moe', 'Set list - array (array --get_set_init)'); $p->nicknames([ 'xsam', 'xmoe' ]); is(join(',', $p->nicknames), 'xsam,xmoe', 'Set list - array ref (array --get_set_init)'); is(join(',', @{$p->nicknames}), 'xsam,xmoe', 'Get list - array ref (array --get_set_init)'); # # array --get_set_inited # my $nicks = $p->idnicknames; ok(ref $nicks eq 'ARRAY' && !@$nicks, 'Get empty array - scalar (array --get_set_inited)'); my @nicks = $p->idnicknames; ok(@nicks == 0, 'Get empty array - list (array --get_set_inited)'); $p->idnicknames('sam', 'moe'); is(join(',', $p->idnicknames), 'sam,moe', 'Set list - array (array --get_set_inited)'); $p->idnicknames([ 'xsam', 'xmoe' ]); is(join(',', $p->idnicknames), 'xsam,xmoe', 'Set list - array ref (array --get_set_inited)'); is(join(',', @{$p->idnicknames}), 'xsam,xmoe', 'Get list - array ref (array --get_set_inited)'); # # datetime # eval { require Rose::DateTime::Util }; SKIP: { if($@) { skip("datetime tests: could not load Rose::DateTime::Util", 13); } $p = Person->new(birthday => '01/24/1984 1:00'); ok(ref $p eq 'Person', 'Construct object (date: with init)'); is($p->birthday(format => '%m/%d/%Y %H:%M:%S'), '01/24/1984 01:00:00', 'Get named attribute (datetime) 1'); $p->birthday('01/24/1984 1:00:01'); is($p->birthday(format => '%m/%d/%Y %H:%M:%S'), '01/24/1984 01:00:01', 'Set named attribute (datetime) 2'); $p->birthday('01/24/1984 1:00:01.1'); is($p->birthday(format => '%m/%d/%Y %H:%M:%S.%1N'), '01/24/1984 01:00:01.1', 'Set named attribute (datetime) 3'); is($p->birthday(format => '%m/%d/%Y %H:%M:%S'), '01/24/1984 01:00:01', 'Set named attribute (datetime) 4'); $p->birthday_floating('01/24/1984 1:00'); is(ref $p->birthday_floating->time_zone, 'DateTime::TimeZone::Floating', 'Check time zone 2'); eval { $p->birthday(foo => 1) }; ok($@, 'Invalid args (datetime)'); eval { $p->birthday(1, 2, 3) }; ok($@, 'Too many args (datetime)'); is($p->arrival(format => '%m/%d/%Y %t'), '01/24/1984 1:10:00 PM', 'Get named attribute (datetime --get_set_init) 1'); is($p->departure(format => '%m/%d/%Y'), '01/30/2000', 'Get named attribute (datetime --get_set_init) 2'); is(ref $p->departure->time_zone, 'DateTime::TimeZone::Floating', 'Check time zone (datetime --get_set_init) 2'); eval { $p->arrival(foo => 1) }; ok($@, 'Invalid args (datetime --get_set_init)'); eval { $p->arrival(1, 2, 3) }; ok($@, 'Too many args (datetime --get_set_init)'); } ## ## Class methods ## # # scalar # is(MyObject->flub('bar'), 'bar', 'Set named class attribute (scalar) 1'); is(MyObject->flub(), 'bar', 'Get named class attribute (scalar) 1'); is(MySubObject->flub(), undef, 'Get named class attribute (scalar) 2'); is(MySubObject->flub('baz'), 'baz', 'Set named class attribute (scalar) 2'); is(MySubObject->flub(), 'baz', 'Get named class attribute (scalar) 3'); # # scalar --get_set_init # is(MyObject->class_type(), 'wacky', 'Get named class attribute (scalar --get_set_init) 1'); is(MyObject->class_type('foob'), 'foob', 'Set named class attribute (scalar --get_set_init) 1'); is(MyObject->class_type(), 'foob', 'Get named class attribute (scalar --get_set_init) 1'); is(MySubObject->class_type(), 'subwacky', 'Get named class attribute (scalar --get_set_init) 2'); is(MySubObject->class_type('baz'), 'baz', 'Set named class attribute (scalar --get_set_init) 2'); is(MySubObject->class_type(), 'baz', 'Get named class attribute (scalar --get_set_init) 3'); # # inheritable_scalar # is(MyObject->name('John'), 'John', 'Set named inheritable class attribute 1'); is(MyObject->name(), 'John', 'Get named inheritable class attribute 1'); is(MySubObject4->name, 'John', 'Get named inheritable class attribute (inherited) 1'); is(MySubObject->name(), 'John', 'Get named inheritable class attribute (inherited) 2'); is(MySubObject2->name(), 'John', 'Get named inheritable class attribute (inherited) 3'); is(MySubObject3->name(), 'John', 'Get named inheritable class attribute (inherited) 4'); is(MySubObject->name('Craig'), 'Craig', 'Set named inheritable class attribute 2'); is(MyObject->name(), 'John', 'Get named inheritable class attribute 2'); is(MySubObject->name(), 'Craig', 'Get named inheritable class attribute (inherited) 5'); is(MySubObject2->name(), 'John', 'Get named inheritable class attribute (inherited) 6'); is(MySubObject3->name(), 'John', 'Get named inheritable class attribute (inherited) 7'); is(MySubObject2->name('Anne'), 'Anne', 'Set named inheritable class attribute 3'); is(MyObject->name(), 'John', 'Get named inheritable class attribute 3'); is(MySubObject->name(), 'Craig', 'Get named inheritable class attribute (inherited) 8'); is(MySubObject2->name(), 'Anne', 'Get named inheritable class attribute (not inherited) 1'); is(MySubObject3->name(), 'Anne', 'Get named inheritable class attribute (inherited) 9'); is(MySubObject4->name, 'Anne', 'Get named inheritable class attribute (inherited) 10'); # # inheritable_boolean # is(MyObject->bool('xxx'), 1, 'Set named inheritable class attribute 1'); is(MyObject->bool(), 1, 'Get named inheritable class attribute 1'); is(MySubObject4->bool, 1, 'Get named inheritable class attribute (inherited) 1'); is(MySubObject->bool(), 1, 'Get named inheritable class attribute (inherited) 2'); is(MySubObject2->bool(), 1, 'Get named inheritable class attribute (inherited) 3'); is(MySubObject3->bool(), 1, 'Get named inheritable class attribute (inherited) 4'); is(MySubObject->bool(''), 0, 'Set named inheritable class attribute 2'); is(MyObject->bool(), 1, 'Get named inheritable class attribute 2'); is(MySubObject->bool(), 0, 'Get named inheritable class attribute (inherited) 5'); is(MySubObject2->bool(), 1, 'Get named inheritable class attribute (inherited) 6'); is(MySubObject3->bool(), 1, 'Get named inheritable class attribute (inherited) 7'); is(MySubObject2->bool(1), 1, 'Set named inheritable class attribute 3'); is(MyObject->bool(), 1, 'Get named inheritable class attribute 3'); is(MySubObject->bool(), 0, 'Get named inheritable class attribute (inherited) 8'); is(MySubObject2->bool(), 1, 'Get named inheritable class attribute (not inherited) 1'); is(MySubObject3->bool(), 1, 'Get named inheritable class attribute (inherited) 9'); is(MySubObject4->bool, 1, 'Get named inheritable class attribute (inherited) 10'); # # POD tests for inheritable_boolean # package MyClass; use Rose::Class::MakeMethods::Generic ( inheritable_boolean => 'enabled', ); package MySubClass; our @ISA = qw(MyClass); package MySubSubClass; our @ISA = qw(MySubClass); package main; is(MyClass->enabled, undef, 'x'); is(MySubClass->enabled, undef, 'x'); is(MySubSubClass->enabled, undef, 'x'); is(MyClass->enabled(1), 1, 'x'); is(MyClass->enabled, 1, 'x'); is(MySubClass->enabled, 1, 'x'); is(MySubSubClass->enabled, 1, 'x'); is(MyClass->enabled(undef), 0, 'x'); is(MyClass->enabled, 0, 'x'); is(MySubClass->enabled, 0, 'x'); is(MySubSubClass->enabled, 0, 'x'); is(MySubClass->enabled(1), 1, 'x'); is(MyClass->enabled, 0, 'x'); is(MySubClass->enabled, 1, 'x'); is(MySubSubClass->enabled, 1, 'x'); is(MyClass->enabled('foo'), 1, 'x'); is(MySubClass->enabled(undef), 0, 'x'); is(MyClass->enabled, 1, 'x'); is(MySubClass->enabled, 0, 'x'); is(MySubSubClass->enabled, 0, 'x'); is(MySubSubClass->enabled(1), 1 , 'x'); is(MyClass->enabled, 1, 'x'); is(MySubClass->enabled, 0, 'x'); is(MySubSubClass->enabled, 1, 'x'); # # hash # ok(!defined MyObject->cparams, 'Get undefined class hash (hash)'); MyObject->cparams(a => 1, b => 2); is(MyObject->cparam('b'), 2, 'Get class hash key (hash)'); my $ch = MyObject->cparams; ok(ref $ch eq 'HASH' && $ch->{'a'} == 1 && $ch->{'b'} == 2, 'Get class hash ref (hash --get-set_all)'); my %ch = MyObject->cparams; ok($ch{'a'} == 1 && $ch{'b'} == 2, 'Get class hash (hash --get-set_all)'); MyObject->cparams({ c => 3, d => 4 }); ok(!MyObject->cparam_exists('a'), 'Check for class hash key existence (hash --exists)'); is(join(',', sort MyObject->cparam_names), 'c,d', 'Get class hash key names (hash --keys)'); is(join(',', sort MyObject->cparam_values), '3,4', 'Get class hash key values (hash --values)'); MyObject->delete_cparam('c'); is(join(',', sort MyObject->cparam_names), 'd', 'Delete cparam (hash --delete)'); MyObject->cparam(f => 7, g => 8); is(join(',', sort MyObject->cparam_values), '4,7,8', 'Add class hash name/value pairs (hash)'); # # inheritable_hash # ok(!defined MyObject->icparams, 'Get undefined inheritable class hash (hash)'); MyObject->icparams(a => 1, b => 2); is(MyObject->icparam('b'), 2, 'Get inheritable class hash key (hash)'); my $ich = MyObject->icparams; ok(ref $ich eq 'HASH' && $ich->{'a'} == 1 && $ich->{'b'} == 2, 'Get inheritable class hash ref (hash --get-set_all)'); my %ich = MyObject->icparams; ok($ich{'a'} == 1 && $ich{'b'} == 2, 'Get inheritable class hash (hash --get-set_all)'); MyObject->icparams({ c => 3, d => 4 }); ok(!MyObject->icparam_exists('a'), 'Check for inheritable class hash key existence (hash --exists)'); is(join(',', sort MyObject->icparam_names), 'c,d', 'Get inheritable class hash key names (hash --keys)'); is(join(',', sort MyObject->icparam_values), '3,4', 'Get inheritable class hash key values (hash --values)'); is(join(',', sort MySubObject->icparam_names), 'c,d', 'Inherited keys 1'); is(join(',', sort MySubObject->icparam_values), '3,4', 'Inherited values 1'); MyObject->delete_icparam('c'); is(join(',', sort MyObject->icparam_names), 'd', 'Delete icparam (hash --delete)'); MyObject->icparam(f => 7, g => 8); is(join(',', sort MyObject->icparam_values), '4,7,8', 'Add inheritable class hash name/value pairs (hash)'); is(join(',', sort MySubObject2->icparam_names), 'd,f,g', 'Inherited keys 2'); is(join(',', sort MySubObject2->icparam_values), '4,7,8', 'Inherited values 2'); is(join(',', sort MySubObject3->icparam_names), 'd,f,g', 'Inherited keys 3'); is(join(',', sort MySubObject3->icparam_values), '4,7,8', 'Inherited values 3'); is(join(',', sort MySubObject->icparam_names), 'c,d', 'Inherited keys 4'); is(join(',', sort MySubObject->icparam_values), '3,4', 'Inherited values 4'); ok(!MySubObject->icparam_exists('f'), 'Inherited exists 1'); ok(MySubObject2->icparam_exists('f'), 'Inherited exists 2'); ok(MySubObject3->icparam_exists('f'), 'Inherited exists 3'); MySubObject3->delete_icparam('f'); MySubObject3->icparam('d' => 9); is(join(',', sort MySubObject->icparam_names), 'c,d', 'Inherited keys 5'); is(join(',', sort MySubObject->icparam_values), '3,4', 'Inherited values 5'); is(join(',', sort MySubObject2->icparam_names), 'd,f,g', 'Inherited keys 6'); is(join(',', sort MySubObject2->icparam_values), '4,7,8', 'Inherited values 6'); is(join(',', sort MySubObject3->icparam_names), 'd,g', 'Inherited keys 7'); is(join(',', sort MySubObject3->icparam_values), '8,9', 'Inherited values 7'); is(join(',', sort MySubObject4->icparam_names), 'd,g', 'Inherited keys 8'); is(join(',', sort MySubObject4->icparam_values), '8,9', 'Inherited values 8'); MySubObject->reset_icparams; is(join(',', sort MySubObject->icparam_names), 'd,f,g', 'reset_icparams() 1'); is(join(',', sort MySubObject->icparam_values), '4,7,8', 'reset_icparams() 2'); MySubObject->clear_icparams; is(join(',', sort MySubObject->icparam_names), '', 'clear_icparams() 1'); is(join(',', sort MySubObject->icparam_values), '', 'clear_icparams() 2'); # # inheritable_set # is(MyObject->add_required_names(qw(foo bar baz)), 3, 'add_required_names() 1'); foreach my $attr (MyObject->required_names) { is(MyObject->name_is_required($attr), 1, "name_is_required() $attr"); is(MySubObject->name_is_valid($attr), 1, "name_is_valid() $attr"); } foreach my $attr (MyObject->required_names) { is(MySubObject2->name_is_required($attr), 1, "name_is_required() inherited $attr"); is(MySubObject2->name_is_valid($attr), 1, "name_is_valid() inherited $attr"); } is(MySubObject3->add_required_names(undef), 0, 'add_required_names() 2'); foreach my $attr (MyObject->required_names) { is(MySubObject3->name_is_required($attr), 1, "name_is_required() not inherited $attr"); is(MySubObject3->name_is_valid($attr), 1, "name_is_valid() not inherited $attr"); } is(MyObject->delete_required_name('foo'), 1, 'delete_required_name() 1'); is(MyObject->name_is_required('foo'), 0, 'delete_required_name() 2'); is(MyObject->name_is_valid('foo'), 1, 'delete_required_name() 3'); is(MySubObject2->name_is_valid('foo'), 1, 'delete_required_name() 4'); is(MySubObject3->name_is_valid('foo'), 1, 'delete_required_name() 5'); is(MyObject->required_name_value(foo => 5), undef, 'required_name_value() 1'); is(MyObject->name_is_required('foo'), 0, "name_is_required() not set foo"); is(MyObject->required_name_value(bar => 5), 5, 'required_name_value() 2'); is(MyObject->required_name_value('bar'), 5, 'required_name_value() 3'); MyObject->clear_required_names; my @names = MyObject->required_names; ok(@names == 0, 'clear_required_names()'); @names = MySubObject4->inheritable_items; is_deeply([ sort @names ], [ 'abase', 'bbase' ], 'inheritable_items() 1'); # # inherited_set # is(MyObject->add_valid_names(qw(foo bar baz)), 3, 'add_valid_names() 1'); foreach my $attr (MyObject->valid_names) { is(MySubObject->name_is_valid($attr), 1, "name_is_valid() inherited $attr"); } MyObject->add_valid_name('blargh'); is(MySubObject->name_is_valid('blargh'), 1, 'name_is_valid() inherited blargh 1'); is(MySubObject2->name_is_valid('blargh'), 1, 'name_is_valid() inherited blargh 2'); MyObject->delete_valid_name('blargh'); is(MySubObject->name_is_valid('blargh'), 0, 'name_is_valid() inherited blargh 3'); is(MySubObject2->name_is_valid('blargh'), 0, 'name_is_valid() inherited blargh 4'); MySubObject->add_valid_name('blargh'); is(MyObject->name_is_valid('blargh'), 0, 'name_is_valid() inherited blargh 5'); is(MySubObject2->name_is_valid('blargh'), 0, 'name_is_valid() inherited blargh 6'); MySubObject->delete_valid_name('blargh'); is(MySubObject->name_is_valid('blargh'), 0, 'name_is_valid() inherited blargh 7'); is(MySubObject2->name_is_valid('blargh'), 0, 'name_is_valid() inherited blargh 8'); is(MyObject->name_is_valid('blargh'), 0, 'name_is_valid() inherited blargh 9'); MyObject->add_valid_name('bloop'); is(MySubObject->name_is_valid('bloop'), 1, 'name_is_valid() inherited bloop 1'); is(MySubObject2->name_is_valid('bloop'), 1, 'name_is_valid() inherited bloop 2'); is(MySubObject3->name_is_valid('bloop'), 1, 'name_is_valid() inherited bloop 3'); is(MyObject->name_is_valid('bloop'), 1, 'name_is_valid() inherited bloop 4'); MySubObject->add_valid_name('bloop'); is(MySubObject->name_is_valid('bloop'), 1, 'name_is_valid() inherited bloop 5'); is(MySubObject2->name_is_valid('bloop'), 1, 'name_is_valid() inherited bloop 6'); is(MySubObject3->name_is_valid('bloop'), 1, 'name_is_valid() inherited bloop 7'); is(MyObject->name_is_valid('bloop'), 1, 'name_is_valid() inherited bloop 8'); MySubObject2->add_valid_name('bloop'); is(MySubObject->name_is_valid('bloop'), 1, 'name_is_valid() inherited bloop 9'); is(MySubObject2->name_is_valid('bloop'), 1, 'name_is_valid() inherited bloop 10'); is(MySubObject3->name_is_valid('bloop'), 1, 'name_is_valid() inherited bloop 11'); is(MyObject->name_is_valid('bloop'), 1, 'name_is_valid() inherited bloop 12'); MySubObject3->add_valid_name('bloop'); is(MySubObject->name_is_valid('bloop'), 1, 'name_is_valid() inherited bloop 13'); is(MySubObject2->name_is_valid('bloop'), 1, 'name_is_valid() inherited bloop 14'); is(MySubObject3->name_is_valid('bloop'), 1, 'name_is_valid() inherited bloop 15'); is(MyObject->name_is_valid('bloop'), 1, 'name_is_valid() inherited bloop 16'); MySubObject->delete_valid_name('bloop'); is(MySubObject->name_is_valid('bloop'), 0, 'name_is_valid() inherited bloop 17'); is(MySubObject2->name_is_valid('bloop'), 1, 'name_is_valid() inherited bloop 18'); is(MySubObject3->name_is_valid('bloop'), 1, 'name_is_valid() inherited bloop 19'); is(MyObject->name_is_valid('bloop'), 1, 'name_is_valid() inherited bloop 20'); MySubObject2->delete_valid_name('bloop'); is(MySubObject->name_is_valid('bloop'), 0, 'name_is_valid() inherited bloop 21'); is(MySubObject2->name_is_valid('bloop'), 0, 'name_is_valid() inherited bloop 22'); is(MySubObject3->name_is_valid('bloop'), 1, 'name_is_valid() inherited bloop 23'); is(MyObject->name_is_valid('bloop'), 1, 'name_is_valid() inherited bloop 24'); MyObject->delete_valid_name('bloop'); is(MySubObject->name_is_valid('bloop'), 0, 'name_is_valid() inherited bloop 25'); is(MySubObject2->name_is_valid('bloop'), 0, 'name_is_valid() inherited bloop 26'); is(MySubObject3->name_is_valid('bloop'), 1, 'name_is_valid() inherited bloop 27'); is(MyObject->name_is_valid('bloop'), 0, 'name_is_valid() inherited bloop 28'); MyObject->add_valid_name('argh'); is(MySubObject->name_is_valid('argh'), 1, 'name_is_valid() inherited argh 1'); is(MySubObject2->name_is_valid('argh'), 1, 'name_is_valid() inherited argh 2'); is(MySubObject3->name_is_valid('argh'), 1, 'name_is_valid() inherited argh 3'); is(MyObject->name_is_valid('argh'), 1, 'name_is_valid() inherited argh 4'); MySubObject2->delete_valid_name('argh'); is(MySubObject->name_is_valid('argh'), 1, 'name_is_valid() inherited argh 5'); is(MySubObject2->name_is_valid('argh'), 0, 'name_is_valid() inherited argh 6'); is(MySubObject3->name_is_valid('argh'), 1, 'name_is_valid() inherited argh 7'); is(MyObject->name_is_valid('argh'), 1, 'name_is_valid() inherited argh 8'); MySubObject->delete_valid_name('argh'); is(MySubObject->name_is_valid('argh'), 0, 'name_is_valid() inherited argh 9'); is(MySubObject2->name_is_valid('argh'), 0, 'name_is_valid() inherited argh 10'); is(MySubObject3->name_is_valid('argh'), 1, 'name_is_valid() inherited argh 11'); is(MyObject->name_is_valid('argh'), 1, 'name_is_valid() inherited argh 12'); MySubObject2->inherit_valid_name('argh'); is(MySubObject->name_is_valid('argh'), 0, 'name_is_valid() inherited argh 13'); is(MySubObject2->name_is_valid('argh'), 1, 'name_is_valid() inherited argh 14'); is(MySubObject3->name_is_valid('argh'), 1, 'name_is_valid() inherited argh 15'); is(MyObject->name_is_valid('argh'), 1, 'name_is_valid() inherited argh 16'); MyObject->clear_valid_names; @names = MyObject->valid_names; ok(@names == 0, 'clear_valid_names()'); # # Inherited set with add_implies # MyObject->add_happy_names(qw(whee splurt foop)); foreach my $attr (MyObject->happy_names) { is(MySubObject->name_is_happy($attr), 1, "name_is_happy() inherited $attr"); is(MySubObject->name_is_valid($attr), 1, "name_is_valid() inherited implied $attr"); } MyObject->add_happy_name('whee'); is(MySubObject->name_is_happy('whee'), 1, 'name_is_happy() inherited whee 1'); is(MySubObject2->name_is_happy('whee'), 1, 'name_is_happy() inherited whee 2'); MyObject->delete_happy_name('whee'); is(MySubObject->name_is_happy('whee'), 0, 'name_is_happy() inherited whee 3'); is(MySubObject2->name_is_happy('whee'), 0, 'name_is_happy() inherited whee 4'); MySubObject->add_happy_name('whee'); is(MyObject->name_is_happy('whee'), 0, 'name_is_happy() inherited whee 5'); is(MySubObject2->name_is_happy('whee'), 0, 'name_is_happy() inherited whee 6'); MySubObject->delete_happy_name('whee'); is(MySubObject->name_is_happy('whee'), 0, 'name_is_happy() inherited whee 7'); is(MySubObject2->name_is_happy('whee'), 0, 'name_is_happy() inherited whee 8'); is(MyObject->name_is_happy('whee'), 0, 'name_is_happy() inherited whee 9'); MyObject->add_happy_name('splurt'); is(MySubObject->name_is_happy('splurt'), 1, 'name_is_happy() inherited splurt 1'); is(MySubObject2->name_is_happy('splurt'), 1, 'name_is_happy() inherited splurt 2'); is(MySubObject3->name_is_happy('splurt'), 1, 'name_is_happy() inherited splurt 3'); is(MyObject->name_is_happy('splurt'), 1, 'name_is_happy() inherited splurt 4'); MySubObject->add_happy_name('splurt'); is(MySubObject->name_is_happy('splurt'), 1, 'name_is_happy() inherited splurt 5'); is(MySubObject2->name_is_happy('splurt'), 1, 'name_is_happy() inherited splurt 6'); is(MySubObject3->name_is_happy('splurt'), 1, 'name_is_happy() inherited splurt 7'); is(MyObject->name_is_happy('splurt'), 1, 'name_is_happy() inherited splurt 8'); MySubObject2->add_happy_name('splurt'); is(MySubObject->name_is_happy('splurt'), 1, 'name_is_happy() inherited splurt 9'); is(MySubObject2->name_is_happy('splurt'), 1, 'name_is_happy() inherited splurt 10'); is(MySubObject3->name_is_happy('splurt'), 1, 'name_is_happy() inherited splurt 11'); is(MyObject->name_is_happy('splurt'), 1, 'name_is_happy() inherited splurt 12'); MySubObject3->add_happy_name('splurt'); is(MySubObject->name_is_happy('splurt'), 1, 'name_is_happy() inherited splurt 13'); is(MySubObject2->name_is_happy('splurt'), 1, 'name_is_happy() inherited splurt 14'); is(MySubObject3->name_is_happy('splurt'), 1, 'name_is_happy() inherited splurt 15'); is(MyObject->name_is_happy('splurt'), 1, 'name_is_happy() inherited splurt 16'); MySubObject->delete_happy_name('splurt'); is(MySubObject->name_is_happy('splurt'), 0, 'name_is_happy() inherited splurt 17'); is(MySubObject2->name_is_happy('splurt'), 1, 'name_is_happy() inherited splurt 18'); is(MySubObject3->name_is_happy('splurt'), 1, 'name_is_happy() inherited splurt 19'); is(MyObject->name_is_happy('splurt'), 1, 'name_is_happy() inherited splurt 20'); MySubObject2->delete_happy_name('splurt'); is(MySubObject->name_is_happy('splurt'), 0, 'name_is_happy() inherited splurt 21'); is(MySubObject2->name_is_happy('splurt'), 0, 'name_is_happy() inherited splurt 22'); is(MySubObject3->name_is_happy('splurt'), 1, 'name_is_happy() inherited splurt 23'); is(MyObject->name_is_happy('splurt'), 1, 'name_is_happy() inherited splurt 24'); MyObject->delete_happy_name('splurt'); is(MySubObject->name_is_happy('splurt'), 0, 'name_is_happy() inherited splurt 25'); is(MySubObject2->name_is_happy('splurt'), 0, 'name_is_happy() inherited splurt 26'); is(MySubObject3->name_is_happy('splurt'), 1, 'name_is_happy() inherited splurt 27'); is(MyObject->name_is_happy('splurt'), 0, 'name_is_happy() inherited splurt 28'); MyObject->add_happy_name('foop'); is(MySubObject->name_is_happy('foop'), 1, 'name_is_happy() inherited foop 1'); is(MySubObject2->name_is_happy('foop'), 1, 'name_is_happy() inherited foop 2'); is(MySubObject3->name_is_happy('foop'), 1, 'name_is_happy() inherited foop 3'); is(MyObject->name_is_happy('foop'), 1, 'name_is_happy() inherited foop 4'); MySubObject2->delete_happy_name('foop'); is(MySubObject->name_is_happy('foop'), 1, 'name_is_happy() inherited foop 5'); is(MySubObject2->name_is_happy('foop'), 0, 'name_is_happy() inherited foop 6'); is(MySubObject3->name_is_happy('foop'), 1, 'name_is_happy() inherited foop 7'); is(MyObject->name_is_happy('foop'), 1, 'name_is_happy() inherited foop 8'); MySubObject->delete_happy_name('foop'); is(MySubObject->name_is_happy('foop'), 0, 'name_is_happy() inherited foop 9'); is(MySubObject2->name_is_happy('foop'), 0, 'name_is_happy() inherited foop 10'); is(MySubObject3->name_is_happy('foop'), 1, 'name_is_happy() inherited foop 11'); is(MyObject->name_is_happy('foop'), 1, 'name_is_happy() inherited foop 12'); MySubObject2->inherit_happy_name('foop'); is(MySubObject->name_is_happy('foop'), 0, 'name_is_happy() inherited foop 13'); is(MySubObject2->name_is_happy('foop'), 1, 'name_is_happy() inherited foop 14'); is(MySubObject3->name_is_happy('foop'), 1, 'name_is_happy() inherited foop 15'); is(MyObject->name_is_happy('foop'), 1, 'name_is_happy() inherited foop 16'); MyObject->delete_valid_name('foop'); is(MyObject->name_is_happy('foop'), 0, 'delete_implies 1'); # # Inherited set with inherit_implies # MyObject->add_happy_name('iip'); is(MySubObject->name_is_valid('iip'), 1, 'name_is_valid() inherited iip 1'); is(MySubObject2->name_is_valid('iip'), 1, 'name_is_valid() inherited iip 2'); is(MySubObject3->name_is_valid('iip'), 1, 'name_is_valid() inherited iip 3'); is(MyObject->name_is_valid('iip'), 1, 'name_is_valid() inherited iip 4'); is(MySubObject->name_is_happy('iip'), 1, 'name_is_happy() inherited iip 1'); is(MySubObject2->name_is_happy('iip'), 1, 'name_is_happy() inherited iip 2'); is(MySubObject3->name_is_happy('iip'), 1, 'name_is_happy() inherited iip 3'); is(MyObject->name_is_happy('iip'), 1, 'name_is_happy() inherited iip 4'); MySubObject->delete_valid_name('iip'); is(MySubObject->name_is_valid('iip'), 0, 'name_is_valid() inherited iip 5'); is(MySubObject2->name_is_valid('iip'), 1, 'name_is_valid() inherited iip 6'); is(MySubObject3->name_is_valid('iip'), 1, 'name_is_valid() inherited iip 7'); is(MyObject->name_is_valid('iip'), 1, 'name_is_valid() inherited iip 8'); is(MySubObject->name_is_happy('iip'), 0, 'name_is_happy() inherited iip 5'); is(MySubObject2->name_is_happy('iip'), 1, 'name_is_happy() inherited iip 6'); is(MySubObject3->name_is_happy('iip'), 1, 'name_is_happy() inherited iip 7'); is(MyObject->name_is_happy('iip'), 1, 'name_is_happy() inherited iip 8'); MySubObject->inherit_valid_name('iip'); is(MySubObject->name_is_valid('iip'), 1, 'name_is_valid() inherited iip 9'); is(MySubObject2->name_is_valid('iip'), 1, 'name_is_valid() inherited iip 10'); is(MySubObject3->name_is_valid('iip'), 1, 'name_is_valid() inherited iip 11'); is(MyObject->name_is_valid('iip'), 1, 'name_is_valid() inherited iip 12'); is(MySubObject->name_is_happy('iip'), 1, 'name_is_happy() inherited iip 9'); is(MySubObject2->name_is_happy('iip'), 1, 'name_is_happy() inherited iip 10'); is(MySubObject3->name_is_happy('iip'), 1, 'name_is_happy() inherited iip 11'); is(MyObject->name_is_happy('iip'), 1, 'name_is_happy() inherited iip 12'); # # inherited_hash # my %v = (foo => 1, bar => 2, baz => 3); is(MyObject->add_val_names(%v), 3, 'add_val_names() 1'); foreach my $attr (MyObject->val_name_keys) { is(MySubObject->val_name_exists($attr), 1, "val_name_exists() inherited $attr"); is(MySubObject->val_name($attr), $v{$attr}, "val_name() inherited $attr"); } is(MyObject->val_names(\%v), 3, 'add_val_names() 2'); foreach my $attr (MyObject->val_name_keys) { is(MySubObject->val_name_exists($attr), 1, "val_name_exists() 2 inherited $attr"); is(MySubObject->val_name($attr), $v{$attr}, "val_name() 2 inherited $attr"); } MyObject->add_val_name(blargh => 11); is(MySubObject->val_name_exists('blargh'), 1, 'val_name_exists() inherited blargh 1'); is(MySubObject2->val_name_exists('blargh'), 1, 'val_name_exists() inherited blargh 2'); is(MySubObject->val_name('blargh'), 11, 'val_name() inherited blargh 1'); is(MySubObject2->val_name('blargh'), 11, 'val_name() inherited blargh 2'); MyObject->delete_val_name('blargh'); is(MySubObject->val_name_exists('blargh'), 0, 'val_name_exists() inherited blargh 3'); is(MySubObject2->val_name_exists('blargh'), 0, 'val_name_exists() inherited blargh 4'); MySubObject->val_name(blargh => 22); is(MyObject->val_name_exists('blargh'), 0, 'val_name_exists() inherited blargh 5'); is(MySubObject2->val_name_exists('blargh'), 0, 'val_name_exists() inherited blargh 6'); is(MySubObject->val_name('blargh'), 22, 'val_name() inherited blargh 3'); is(MySubObject2->val_name_exists('blargh'), 0, 'val_name_exists() inherited blargh 4'); MySubObject->delete_val_name('blargh'); is(MySubObject->val_name_exists('blargh'), 0, 'val_name_exists() inherited blargh 7'); is(MySubObject2->val_name_exists('blargh'), 0, 'val_name_exists() inherited blargh 8'); is(MyObject->val_name_exists('blargh'), 0, 'val_name_exists() inherited blargh 9'); MyObject->add_val_name(bloop => 33); is(MySubObject->val_name_exists('bloop'), 1, 'val_name_exists() inherited bloop 1'); is(MySubObject->val_name('bloop'), 33, 'val_name() inherited bloop 1'); is(MySubObject2->val_name_exists('bloop'), 1, 'val_name_exists() inherited bloop 2'); is(MySubObject2->val_name('bloop'), 33, 'val_name() inherited bloop 2'); is(MySubObject3->val_name_exists('bloop'), 1, 'val_name_exists() inherited bloop 3'); is(MySubObject3->val_name('bloop'), 33, 'val_name() inherited bloop 3'); is(MyObject->val_name_exists('bloop'), 1, 'val_name_exists() inherited bloop 4'); is(MyObject->val_name('bloop'), 33, 'val_name() inherited bloop 4'); MySubObject->add_val_name(bloop => 44); is(MySubObject->val_name_exists('bloop'), 1, 'val_name_exists() inherited bloop 5'); is(MySubObject->val_name('bloop'), 44, 'val_name() inherited bloop 5'); is(MySubObject2->val_name_exists('bloop'), 1, 'val_name_exists() inherited bloop 6'); is(MySubObject2->val_name('bloop'), 33, 'val_name() inherited bloop 6'); is(MySubObject3->val_name_exists('bloop'), 1, 'val_name_exists() inherited bloop 7'); is(MySubObject3->val_name('bloop'), 33, 'val_name() inherited bloop 7'); is(MyObject->val_name_exists('bloop'), 1, 'val_name_exists() inherited bloop 8'); is(MyObject->val_name('bloop'), 33, 'val_name() inherited bloop 8'); MySubObject2->val_name(bloop => 55); is(MySubObject->val_name_exists('bloop'), 1, 'val_name_exists() inherited bloop 9'); is(MySubObject->val_name('bloop'), 44, 'val_name() inherited bloop 9'); is(MySubObject2->val_name_exists('bloop'), 1, 'val_name_exists() inherited bloop 10'); is(MySubObject2->val_name('bloop'), 55, 'val_name() inherited bloop 10'); is(MySubObject3->val_name_exists('bloop'), 1, 'val_name_exists() inherited bloop 11'); is(MySubObject3->val_name('bloop'), 55, 'val_name() inherited bloop 11'); is(MyObject->val_name_exists('bloop'), 1, 'val_name_exists() inherited bloop 12'); is(MyObject->val_name('bloop'), 33, 'val_name() inherited bloop 12'); MySubObject3->add_val_name(bloop => 66); is(MySubObject->val_name_exists('bloop'), 1, 'val_name_exists() inherited bloop 13'); is(MySubObject->val_name('bloop'), 44, 'val_name() inherited bloop 13'); is(MySubObject2->val_name_exists('bloop'), 1, 'val_name_exists() inherited bloop 14'); is(MySubObject2->val_name('bloop'), 55, 'val_name() inherited bloop 14'); is(MySubObject3->val_name_exists('bloop'), 1, 'val_name_exists() inherited bloop 15'); is(MySubObject3->val_name('bloop'), 66, 'val_name() inherited bloop 15'); is(MyObject->val_name_exists('bloop'), 1, 'val_name_exists() inherited bloop 16'); is(MyObject->val_name('bloop'), 33, 'val_name() inherited bloop 16'); MySubObject->delete_val_name('bloop'); is(MySubObject->val_name_exists('bloop'), 0, 'val_name_exists() inherited bloop 17'); is(MySubObject2->val_name_exists('bloop'), 1, 'val_name_exists() inherited bloop 18'); is(MySubObject3->val_name_exists('bloop'), 1, 'val_name_exists() inherited bloop 19'); is(MyObject->val_name_exists('bloop'), 1, 'val_name_exists() inherited bloop 20'); MySubObject2->delete_val_name('bloop'); is(MySubObject->val_name_exists('bloop'), 0, 'val_name_exists() inherited bloop 21'); is(MySubObject2->val_name_exists('bloop'), 0, 'val_name_exists() inherited bloop 22'); is(MySubObject3->val_name_exists('bloop'), 1, 'val_name_exists() inherited bloop 23'); is(MyObject->val_name_exists('bloop'), 1, 'val_name_exists() inherited bloop 24'); MyObject->delete_val_name('bloop'); is(MySubObject->val_name_exists('bloop'), 0, 'val_name_exists() inherited bloop 25'); is(MySubObject2->val_name_exists('bloop'), 0, 'val_name_exists() inherited bloop 26'); is(MySubObject3->val_name_exists('bloop'), 1, 'val_name_exists() inherited bloop 27'); is(MyObject->val_name_exists('bloop'), 0, 'val_name_exists() inherited bloop 28'); MyObject->val_name(argh => 100); is(MySubObject->val_name_exists('argh'), 1, 'val_name_exists() inherited argh 1'); is(MySubObject->val_name('argh'), 100, 'val_name() inherited argh 1'); is(MySubObject2->val_name_exists('argh'), 1, 'val_name_exists() inherited argh 2'); is(MySubObject2->val_name('argh'), 100, 'val_name() inherited argh 2'); is(MySubObject3->val_name_exists('argh'), 1, 'val_name_exists() inherited argh 3'); is(MySubObject3->val_name('argh'), 100, 'val_name() inherited argh 3'); is(MyObject->val_name_exists('argh'), 1, 'val_name_exists() inherited argh 4'); is(MyObject->val_name('argh'), 100, 'val_name() inherited argh 4'); MySubObject2->delete_val_name('argh'); is(MySubObject->val_name_exists('argh'), 1, 'val_name_exists() inherited argh 5'); is(MySubObject->val_name('argh'), 100, 'val_name() inherited argh 5'); is(MySubObject2->val_name_exists('argh'), 0, 'val_name_exists() inherited argh 6'); is(MySubObject3->val_name_exists('argh'), 1, 'val_name_exists() inherited argh 7'); is(MySubObject3->val_name('argh'), 100, 'val_name() inherited argh 7'); is(MyObject->val_name_exists('argh'), 1, 'val_name_exists() inherited argh 8'); is(MyObject->val_name('argh'), 100, 'val_name() inherited argh 8'); MySubObject->delete_val_name('argh'); is(MySubObject->val_name_exists('argh'), 0, 'val_name_exists() inherited argh 9'); is(MySubObject2->val_name_exists('argh'), 0, 'val_name_exists() inherited argh 10'); is(MySubObject3->val_name_exists('argh'), 1, 'val_name_exists() inherited argh 11'); is(MySubObject3->val_name('argh'), 100, 'val_name() inherited argh 11'); is(MyObject->val_name_exists('argh'), 1, 'val_name_exists() inherited argh 12'); is(MyObject->val_name('argh'), 100, 'val_name() inherited argh 12'); MySubObject2->inherit_val_name('argh'); is(MySubObject->val_name_exists('argh'), 0, 'val_name_exists() inherited argh 13'); is(MySubObject2->val_name_exists('argh'), 1, 'val_name_exists() inherited argh 14'); is(MySubObject2->val_name('argh'), 100, 'val_name() inherited argh 14'); is(MySubObject3->val_name_exists('argh'), 1, 'val_name_exists() inherited argh 15'); is(MySubObject3->val_name('argh'), 100, 'val_name() inherited argh 15'); is(MyObject->val_name_exists('argh'), 1, 'val_name_exists() inherited argh 16'); is(MyObject->val_name('argh'), 100, 'val_name() inherited argh 16'); MyObject->clear_val_names; @names = MyObject->val_name_keys; ok(@names == 0, 'clear_val_names()'); # # Inherited set with add_implies # %v = (whee => 1, splurt => 2, foop => 3); MyObject->hval_names(%v); foreach my $attr (MyObject->hval_name_keys) { is(MySubObject->hval_name_exists($attr), 1, "hval_name_exists() inherited $attr"); is(MySubObject->val_name_exists($attr), 1, "val_name_exists() inherited implied $attr"); } MyObject->add_hval_name(whee => 1); is(MySubObject->hval_name_exists('whee'), 1, 'hval_name_exists() inherited whee 1'); is(MySubObject2->hval_name_exists('whee'), 1, 'hval_name_exists() inherited whee 2'); MyObject->delete_hval_name('whee'); is(MySubObject->hval_name_exists('whee'), 0, 'hval_name_exists() inherited whee 3'); is(MySubObject->hval_name('whee'), undef, 'hval_name() inherited whee 3'); is(MySubObject2->hval_name_exists('whee'), 0, 'hval_name_exists() inherited whee 4'); is(MySubObject2->hval_name('whee'), undef, 'hval_name() inherited whee 4'); MySubObject->hval_name(whee => 11); is(MyObject->hval_name_exists('whee'), 0, 'hval_name_exists() inherited whee 5'); is(MyObject->hval_name('whee'), undef, 'hval_name() inherited whee 5'); is(MySubObject2->hval_name_exists('whee'), 0, 'hval_name_exists() inherited whee 6'); is(MySubObject2->hval_name('whee'), undef, 'hval_name() inherited whee 6'); MySubObject->delete_hval_name('whee'); is(MySubObject->hval_name_exists('whee'), 0, 'hval_name_exists() inherited whee 7'); is(MySubObject2->hval_name_exists('whee'), 0, 'hval_name_exists() inherited whee 8'); is(MyObject->hval_name_exists('whee'), 0, 'hval_name_exists() inherited whee 9'); MyObject->hval_name(splurt => 2); is(MySubObject->hval_name_exists('splurt'), 1, 'hval_name_exists() inherited splurt 1'); is(MySubObject->hval_name('splurt'), 2, 'hval_name() inherited splurt 1'); is(MySubObject2->hval_name_exists('splurt'), 1, 'hval_name_exists() inherited splurt 2'); is(MySubObject2->hval_name('splurt'), 2, 'hval_name() inherited splurt 2'); is(MySubObject3->hval_name_exists('splurt'), 1, 'hval_name_exists() inherited splurt 3'); is(MySubObject3->hval_name('splurt'), 2, 'hval_name() inherited splurt 3'); is(MyObject->hval_name_exists('splurt'), 1, 'hval_name_exists() inherited splurt 4'); is(MyObject->hval_name('splurt'), 2, 'hval_name() inherited splurt 4'); MySubObject->add_hval_name(splurt => 2); is(MySubObject->hval_name_exists('splurt'), 1, 'hval_name_exists() inherited splurt 5'); is(MySubObject->hval_name('splurt'), 2, 'hval_name() inherited splurt 5'); is(MySubObject2->hval_name_exists('splurt'), 1, 'hval_name_exists() inherited splurt 6'); is(MySubObject2->hval_name('splurt'), 2, 'hval_name() inherited splurt 6'); is(MySubObject3->hval_name_exists('splurt'), 1, 'hval_name_exists() inherited splurt 7'); is(MySubObject3->hval_name('splurt'), 2, 'hval_name() inherited splurt 7'); is(MyObject->hval_name_exists('splurt'), 1, 'hval_name_exists() inherited splurt 8'); is(MyObject->hval_name('splurt'), 2, 'hval_name() inherited splurt 8'); MySubObject2->add_hval_name(splurt => 2); is(MySubObject->hval_name_exists('splurt'), 1, 'hval_name_exists() inherited splurt 9'); is(MySubObject2->hval_name_exists('splurt'), 1, 'hval_name_exists() inherited splurt 10'); is(MySubObject3->hval_name_exists('splurt'), 1, 'hval_name_exists() inherited splurt 11'); is(MyObject->hval_name_exists('splurt'), 1, 'hval_name_exists() inherited splurt 12'); MySubObject3->add_hval_name(splurt => 2); is(MySubObject->hval_name_exists('splurt'), 1, 'hval_name_exists() inherited splurt 13'); is(MySubObject2->hval_name_exists('splurt'), 1, 'hval_name_exists() inherited splurt 14'); is(MySubObject3->hval_name_exists('splurt'), 1, 'hval_name_exists() inherited splurt 15'); is(MyObject->hval_name_exists('splurt'), 1, 'hval_name_exists() inherited splurt 16'); MySubObject->delete_hval_name('splurt'); is(MySubObject->hval_name_exists('splurt'), 0, 'hval_name_exists() inherited splurt 17'); is(MySubObject->hval_name('splurt'), undef, 'hval_name() inherited splurt 17'); is(MySubObject2->hval_name_exists('splurt'), 1, 'hval_name_exists() inherited splurt 18'); is(MySubObject2->hval_name('splurt'), 2, 'hval_name() inherited splurt 18'); is(MySubObject3->hval_name_exists('splurt'), 1, 'hval_name_exists() inherited splurt 19'); is(MySubObject3->hval_name('splurt'), 2, 'hval_name() inherited splurt 19'); is(MyObject->hval_name_exists('splurt'), 1, 'hval_name_exists() inherited splurt 20'); is(MyObject->hval_name('splurt'), 2, 'hval_name() inherited splurt 20'); MySubObject2->delete_hval_name('splurt'); is(MySubObject->hval_name_exists('splurt'), 0, 'hval_name_exists() inherited splurt 21'); is(MySubObject2->hval_name_exists('splurt'), 0, 'hval_name_exists() inherited splurt 22'); is(MySubObject3->hval_name_exists('splurt'), 1, 'hval_name_exists() inherited splurt 23'); is(MyObject->hval_name_exists('splurt'), 1, 'hval_name_exists() inherited splurt 24'); MyObject->delete_hval_name('splurt'); is(MySubObject->hval_name_exists('splurt'), 0, 'hval_name_exists() inherited splurt 25'); is(MySubObject2->hval_name_exists('splurt'), 0, 'hval_name_exists() inherited splurt 26'); is(MySubObject3->hval_name_exists('splurt'), 1, 'hval_name_exists() inherited splurt 27'); is(MyObject->hval_name_exists('splurt'), 0, 'hval_name_exists() inherited splurt 28'); MyObject->add_hval_name(foop => 3); is(MySubObject->hval_name_exists('foop'), 1, 'hval_name_exists() inherited foop 1'); is(MySubObject->hval_name('foop'), 3, 'hval_name() inherited foop 1'); is(MySubObject2->hval_name_exists('foop'), 1, 'hval_name_exists() inherited foop 2'); is(MySubObject2->hval_name('foop'), 3, 'hval_name() inherited foop 2'); is(MySubObject3->hval_name_exists('foop'), 1, 'hval_name_exists() inherited foop 3'); is(MySubObject3->hval_name('foop'), 3, 'hval_name() inherited foop 3'); is(MyObject->hval_name_exists('foop'), 1, 'hval_name_exists() inherited foop 4'); is(MyObject->hval_name('foop'), 3, 'hval_name() inherited foop 4'); MySubObject2->delete_hval_name('foop'); is(MySubObject->hval_name_exists('foop'), 1, 'hval_name_exists() inherited foop 5'); is(MySubObject->hval_name('foop'), 3, 'hval_name() inherited foop 5'); is(MySubObject2->hval_name_exists('foop'), 0, 'hval_name_exists() inherited foop 6'); is(MySubObject2->hval_name('foop'), undef, 'hval_name() inherited foop 6'); is(MySubObject3->hval_name_exists('foop'), 1, 'hval_name_exists() inherited foop 7'); is(MySubObject3->hval_name('foop'), 3, 'hval_name() inherited foop 7'); is(MyObject->hval_name_exists('foop'), 1, 'hval_name_exists() inherited foop 8'); is(MyObject->hval_name('foop'), 3, 'hval_name() inherited foop 8'); MySubObject->delete_hval_name('foop'); is(MySubObject->hval_name_exists('foop'), 0, 'hval_name_exists() inherited foop 9'); is(MySubObject->hval_name('foop'), undef, 'hval_name() inherited foop 9'); is(MySubObject2->hval_name_exists('foop'), 0, 'hval_name_exists() inherited foop 10'); is(MySubObject2->hval_name('foop'), undef, 'hval_name() inherited foop 10'); is(MySubObject3->hval_name_exists('foop'), 1, 'hval_name_exists() inherited foop 11'); is(MySubObject3->hval_name('foop'), 3, 'hval_name() inherited foop 11'); is(MyObject->hval_name_exists('foop'), 1, 'hval_name_exists() inherited foop 12'); is(MyObject->hval_name('foop'), 3, 'hval_name() inherited foop 12'); MySubObject2->inherit_hval_name('foop'); is(MySubObject->hval_name_exists('foop'), 0, 'hval_name_exists() inherited foop 13'); is(MySubObject->hval_name('foop'), undef, 'hval_name() inherited foop 13'); is(MySubObject2->hval_name_exists('foop'), 1, 'hval_name_exists() inherited foop 14'); is(MySubObject2->hval_name('foop'), 3, 'hval_name() inherited foop 14'); is(MySubObject3->hval_name_exists('foop'), 1, 'hval_name_exists() inherited foop 15'); is(MySubObject3->hval_name('foop'), 3, 'hval_name() inherited foop 15'); is(MyObject->hval_name_exists('foop'), 1, 'hval_name_exists() inherited foop 16'); is(MyObject->hval_name('foop'), 3, 'hval_name() inherited foop 16'); MyObject->delete_hval_name('foop'); is(MyObject->hval_name_exists('foop'), 0, 'delete_implies 1'); # # Inherited set with inherit_implies # MyObject->add_hval_name(iip => 227); is(MySubObject->val_name_exists('iip'), 1, 'val_name_exists() inherited iip 3'); is(MySubObject->val_name('iip'), 227, 'val_name() inherited iip 1'); is(MySubObject2->val_name_exists('iip'), 1, 'val_name_exists() inherited iip 3'); is(MySubObject2->val_name('iip'), 227, 'val_name() inherited iip 2'); is(MySubObject3->val_name_exists('iip'), 1, 'val_name_exists() inherited iip 3'); is(MySubObject3->val_name('iip'), 227, 'val_name() inherited iip 3'); is(MyObject->val_name_exists('iip'), 1, 'val_name_exists() inherited iip 3'); is(MyObject->val_name('iip'), 227, 'val_name() inherited iip 4'); is(MySubObject->hval_name_exists('iip'), 1, 'hval_name_exists() inherited iip 1'); is(MySubObject->hval_name('iip'), 227, 'hval_name() inherited iip 1'); is(MySubObject2->hval_name_exists('iip'), 1, 'hval_name_exists() inherited iip 2'); is(MySubObject2->hval_name('iip'), 227, 'hval_name() inherited iip 2'); is(MySubObject3->hval_name_exists('iip'), 1, 'hval_name_exists() inherited iip 3'); is(MySubObject3->hval_name('iip'), 227, 'hval_name() inherited iip 3'); is(MyObject->hval_name_exists('iip'), 1, 'hval_name_exists() inherited iip 4'); is(MyObject->hval_name('iip'), 227, 'hval_name() inherited iip 4'); MySubObject->delete_val_name('iip'); is(MySubObject->val_name_exists('iip'), 0, 'val_name_exists() inherited iip 3'); is(MySubObject->val_name('iip'), undef, 'val_name() inherited iip 5'); is(MySubObject2->val_name_exists('iip'), 1, 'val_name_exists() inherited iip 3'); is(MySubObject2->val_name('iip'), 227, 'val_name() inherited iip 6'); is(MySubObject3->val_name_exists('iip'), 1, 'val_name_exists() inherited iip 3'); is(MySubObject3->val_name('iip'), 227, 'val_name() inherited iip 7'); is(MyObject->val_name_exists('iip'), 1, 'val_name_exists() inherited iip 3'); is(MyObject->val_name('iip'), 227, 'val_name() inherited iip 8'); is(MySubObject->hval_name_exists('iip'), 0, 'hval_name_exists() inherited iip 3'); is(MySubObject->hval_name('iip'), undef, 'hval_name() inherited iip 5'); is(MySubObject2->hval_name_exists('iip'), 1, 'hval_name_exists() inherited iip 3'); is(MySubObject2->hval_name('iip'), 227, 'hval_name() inherited iip 6'); is(MySubObject3->hval_name_exists('iip'), 1, 'hval_name_exists() inherited iip 3'); is(MySubObject3->hval_name('iip'), 227, 'hval_name() inherited iip 7'); is(MyObject->hval_name_exists('iip'), 1, 'hval_name_exists() inherited iip 3'); is(MyObject->hval_name('iip'), 227, 'hval_name() inherited iip 8'); MySubObject->inherit_val_name('iip'); is(MySubObject->val_name_exists('iip'), 1, 'val_name_exists() inherited iip 3'); is(MySubObject->val_name('iip'), 227, 'val_name() inherited iip 9'); is(MySubObject2->val_name_exists('iip'), 1, 'val_name_exists() inherited iip 3'); is(MySubObject2->val_name('iip'), 227, 'val_name() inherited iip 10'); is(MySubObject3->val_name_exists('iip'), 1, 'val_name_exists() inherited iip 3'); is(MySubObject3->val_name('iip'), 227, 'val_name() inherited iip 11'); is(MyObject->val_name_exists('iip'), 1, 'val_name_exists() inherited iip 3'); is(MyObject->val_name('iip'), 227, 'val_name() inherited iip 12'); is(MySubObject->hval_name_exists('iip'), 1, 'hval_name_exists() inherited iip 3'); is(MySubObject->hval_name('iip'), 227, 'hval_name() inherited iip 9'); is(MySubObject2->hval_name_exists('iip'), 1, 'hval_name_exists() inherited iip 3'); is(MySubObject2->hval_name('iip'), 227, 'hval_name() inherited iip 10'); is(MySubObject3->hval_name_exists('iip'), 1, 'hval_name_exists() inherited iip 3'); is(MySubObject3->hval_name('iip'), 227, 'hval_name() inherited iip 11'); is(MyObject->hval_name_exists('iip'), 1, 'hval_name_exists() inherited iip 3'); is(MyObject->hval_name('iip'), 227, 'hval_name() inherited iip 12'); INHERITED_HASH_POD_CHECK: { package MyClass; use Rose::Class::MakeMethods::Generic ( inherited_hash => [ pet_color => { keys_method => 'pets', delete_implies => 'delete_special_pet_color', inherit_implies => 'inherit_special_pet_color', }, special_pet_color => { keys_method => 'special_pets', add_implies => 'add_pet_color', }, ], ); package main; my $i = 1; MyClass->pet_colors(Fido => 'white', Max => 'black', Spot => 'yellow'); MyClass->special_pet_color(Toby => 'tan'); is(join(', ', sort MyClass->pets), 'Fido, Max, Spot, Toby', 'inherited_hash pod ' . $i++); is(join(', ', sort MyClass->special_pets), 'Toby', 'inherited_hash pod ' . $i++); is(join(', ', sort MySubClass->pets), 'Fido, Max, Spot, Toby', 'inherited_hash pod ' . $i++); is(join(', ', sort MyClass->pet_color('Toby')), 'tan', 'inherited_hash pod ' . $i++); MySubClass->special_pet_color(Toby => 'gold'); is(join(', ', sort MyClass->pet_color('Toby')), 'tan', 'inherited_hash pod ' . $i++); is(join(', ', sort MyClass->special_pet_color('Toby')), 'tan', 'inherited_hash pod ' . $i++); is(join(', ', sort MySubClass->pet_color('Toby')), 'gold', 'inherited_hash pod ' . $i++); is(join(', ', sort MySubClass->special_pet_color('Toby')), 'gold', 'inherited_hash pod ' . $i++); MySubClass->inherit_pet_color('Toby'); is(join(', ', sort MySubClass->pet_color('Toby')), 'tan', 'inherited_hash pod ' . $i++); is(join(', ', sort MySubClass->special_pet_color('Toby')), 'tan', 'inherited_hash pod ' . $i++); MyClass->delete_pet_color('Max'); is(join(', ', sort MyClass->pets), 'Fido, Spot, Toby', 'inherited_hash pod ' . $i++); is(join(', ', sort MySubClass->pets), 'Fido, Spot, Toby', 'inherited_hash pod ' . $i++); MyClass->special_pet_color(Max => 'mauve'); is(join(', ', sort MyClass->pets), 'Fido, Max, Spot, Toby', 'inherited_hash pod ' . $i++); is(join(', ', sort MySubClass->pets), 'Fido, Max, Spot, Toby', 'inherited_hash pod ' . $i++); is(join(', ', sort MyClass->special_pets), 'Max, Toby', 'inherited_hash pod ' . $i++); is(join(', ', sort MySubClass->special_pets), 'Max, Toby', 'inherited_hash pod ' . $i++); MySubClass->delete_special_pet_color('Max'); is(join(', ', sort MyClass->pets), 'Fido, Max, Spot, Toby', 'inherited_hash pod ' . $i++); is(join(', ', sort MySubClass->pets), 'Fido, Max, Spot, Toby', 'inherited_hash pod ' . $i++); is(join(', ', sort MyClass->special_pets), 'Max, Toby', 'inherited_hash pod ' . $i++); is(join(', ', sort MySubClass->special_pets), 'Toby', 'inherited_hash pod ' . $i++); } BEGIN { use Test::More(); package Person; use strict; @Person::ISA = qw(Rose::Object); use Rose::Object::MakeMethods::Generic ( 'boolean' => 'is_foo', 'boolean --get_set_init' => [ 'is_def_foo', ], 'boolean' => [ is_valid => { default => 1 }, ], 'boolean --default=0' => 'def0', 'scalar' => 'bar', 'scalar --get_set_init' => [ qw(type) ], hash => [ param => { hash_key => 'params' }, params => { interface => 'get_set_all' }, param_names => { interface => 'keys', hash_key => 'params' }, param_values => { interface => 'values', hash_key => 'params' }, param_exists => { interface => 'exists', hash_key => 'params' }, delete_param => { interface => 'delete', hash_key => 'params' }, clear_params => { interface => 'clear', hash_key => 'params' }, reset_params => { interface => 'reset', hash_key => 'params' }, iparams => { interface => 'get_set_init' }, reset_iparams => { interface => 'reset', hash_key => 'iparams' }, clear_iparams => { interface => 'clear', hash_key => 'iparams' }, idparams => { interface => 'get_set_inited' }, clear_idparams => { interface => 'clear', hash_key => 'idparams' }, reset_idparams => { interface => 'reset', hash_key => 'idparams' }, fhash => { interface => 'get_set_init_all' }, ], array => 'jobs', array => [ job => { interface => 'get_set_item', hash_key => 'jobs' }, clear_jobs => { interface => 'clear', hash_key => 'jobs' }, push_jobs => { interface => 'push', hash_key => 'jobs' }, pop_jobs => { interface => 'pop', hash_key => 'jobs' }, unshift_jobs => { interface => 'unshift', hash_key => 'jobs' }, shift_jobs => { interface => 'shift', hash_key => 'jobs' }, ], array => [ nicknames => { interface => 'get_set_init' }, idnicknames => { interface => 'get_set_inited' }, ], ); SKIP: { eval { require Rose::DateTime::Util }; if($@) { Test::More::skip('loading Rose::Object::MakeMethods::DateTime', 1); } else { Test::More::use_ok('Rose::Object::MakeMethods::DateTime'); eval " use Rose::Object::MakeMethods::DateTime ( datetime => [ 'birthday' ], datetime => [ birthday_floating => { tz => 'floating' } ], 'datetime --get_set_init' => 'arrival', 'datetime --get_set_init' => [ 'departure' => { tz => 'floating' } ], ); "; } } sub init_fhash { { a => 1, b => 2 } } sub init_arrival { '1/24/1984 1:10pm' } sub init_departure { DateTime->new(month => 1, day => 30, year => 2000, time_zone => 'UTC') } sub init_is_def_foo { 123 } sub init_type { 'default' } sub init_nicknames { [ qw(wiley joe) ] } sub init_iparams { { a => 1, b => 2 } } package MyObject; use Rose::Class::MakeMethods::Generic ( 'inheritable_scalar' => 'name', 'inheritable_boolean' => 'bool', scalar => [ 'flub', 'class_type' => { interface => 'get_set_init' }, ], hash => [ cparam => { hash_key => 'cparams' }, cparams => { interface => 'get_set_all' }, cparam_names => { interface => 'keys', hash_key => 'cparams' }, cparam_values => { interface => 'values', hash_key => 'cparams' }, cparam_exists => { interface => 'exists', hash_key => 'cparams' }, delete_cparam => { interface => 'delete', hash_key => 'cparams' }, clear_cparams => { interface => 'clear', hash_key => 'cparams' }, ], inheritable_hash => [ icparam => { hash_key => 'icparams' }, icparams => { interface => 'get_set_all' }, icparam_names => { interface => 'keys', hash_key => 'icparams' }, icparam_values => { interface => 'values', hash_key => 'icparams' }, icparam_exists => { interface => 'exists', hash_key => 'icparams' }, delete_icparam => { interface => 'delete', hash_key => 'icparams' }, clear_icparams => { interface => 'clear', hash_key => 'icparams' }, reset_icparams => { interface => 'reset', hash_key => 'icparams' }, ], inherited_hash => [ val_name => { exists_method => 'val_name_exists', delete_implies => 'delete_hval_name', inherit_implies => 'inherit_hval_name', }, hval_name => { add_implies => 'add_val_name', exists_method => 'hval_name_exists', }, ], ); sub init_class_type { 'wacky' } use Rose::Class::MakeMethods::Set ( 'inheritable_set --add_implies=nonesuch' => [ required_name => { add_implies => 'add_valid_name', test_method => 'name_is_required', }, ], inheritable_set => 'inheritable_item', inherited_set => [ valid_name => { test_method => 'name_is_valid', delete_implies => 'delete_happy_name', inherit_implies => 'inherit_happy_name', }, happy_name => { add_implies => 'add_valid_name', test_method => 'name_is_happy', }, ], ); MyObject->add_inheritable_items(qw(abase bbase)); package MySubObject; our @ISA = qw(MyObject); sub init_class_type { 'subwacky' } package MySubObject2; our @ISA = qw(MyObject); package MySubObject3; our @ISA = qw(MySubObject2); package MySubObject4; our @ISA = qw(MySubObject3); }