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