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