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