1use Test::More tests => 36; 2use strict; 3use warnings; 4use lib 't/lib'; 5use SuperInheritedGroups; 6use NotHashBased; 7 8my $super = SuperInheritedGroups->new; 9my $base = BaseInheritedGroups->new; 10 11my @ret = SuperInheritedGroups->basefield; 12 13ok(@ret == 1, 'Return value before set'); 14ok(!defined(SuperInheritedGroups->basefield), 'Undef return before set'); 15 16# set base. base, super, object = base 17is(BaseInheritedGroups->basefield('All Your Base'), 'All Your Base'); 18is(SuperInheritedGroups->basefield, 'All Your Base'); 19is($super->basefield, 'All Your Base'); 20is($base->basefield, 'All Your Base'); 21 22# set super. super = super, base = base, object = super 23is(SuperInheritedGroups->basefield('Now Its Our Base'), 'Now Its Our Base'); 24is(SuperInheritedGroups->basefield, 'Now Its Our Base'); 25is(BaseInheritedGroups->basefield, 'All Your Base'); 26is($super->basefield, 'Now Its Our Base'); 27is($base->basefield, 'All Your Base'); 28 29#set base 30is($base->basefield('First Base'), 'First Base'); 31is($base->basefield, 'First Base'); 32is($super->basefield, 'Now Its Our Base'); 33is(BaseInheritedGroups->basefield, 'All Your Base'); 34is(SuperInheritedGroups->basefield, 'Now Its Our Base'); 35 36# set object, object = object, super = super, base = base 37is($super->basefield('Third Base'), 'Third Base'); 38is($super->basefield, 'Third Base'); 39is(SuperInheritedGroups->basefield, 'Now Its Our Base'); 40is(BaseInheritedGroups->basefield, 'All Your Base'); 41 42# create new super. new = base, object = object, super = super, base = base 43my $newsuper = SuperInheritedGroups->new; 44is($newsuper->basefield, 'Now Its Our Base'); 45is($super->basefield, 'Third Base'); 46is(SuperInheritedGroups->basefield, 'Now Its Our Base'); 47is(BaseInheritedGroups->basefield, 'All Your Base'); 48 49# create new base. new = base, super = super, base = base 50my $newbase = BaseInheritedGroups->new; 51is($newbase->basefield, 'All Your Base'); 52is($newsuper->basefield, 'Now Its Our Base'); 53is($super->basefield, 'Third Base'); 54is(SuperInheritedGroups->basefield, 'Now Its Our Base'); 55is(BaseInheritedGroups->basefield, 'All Your Base'); 56 57# croak on get/set on non hash-based object 58my $dying = NotHashBased->new; 59 60eval { 61 $dying->killme; 62}; 63ok($@ =~ /Cannot get.*is not hash-based/); 64 65eval { 66 $dying->killme('foo'); 67}; 68ok($@ =~ /Cannot set.*is not hash-based/); 69 70# make sure we're get defined items, even 0, '' 71BaseInheritedGroups->basefield('base'); 72SuperInheritedGroups->basefield(0); 73is(SuperInheritedGroups->basefield, 0); 74 75BaseInheritedGroups->basefield('base'); 76SuperInheritedGroups->basefield(''); 77is(SuperInheritedGroups->basefield, ''); 78 79BaseInheritedGroups->basefield('base'); 80SuperInheritedGroups->basefield(undef); 81is(SuperInheritedGroups->basefield, 'base'); 82 83is(BaseInheritedGroups->undefined, undef); 84 85# make sure run-time @ISA changes trigger an inheritance chain recalculation 86SuperInheritedGroups->basefield(undef); 87BaseInheritedGroups->basefield('your base'); 88 89# dirty hack, emulate Class::C3::Componentised 90require ExtraInheritedGroups; 91unshift @SuperInheritedGroups::ISA, qw/ExtraInheritedGroups/; 92 93# this comes from ExtraInheritedGroups 94is(SuperInheritedGroups->basefield, 'your extra base!'); 95