Commit | Line | Data |
f892c0f0 |
1 | #!/usr/bin/perl |
2 | |
3 | use strict; |
4 | use warnings; |
5 | |
6 | use Test::More tests => 65; |
7 | use File::Spec; |
8 | |
9 | BEGIN { |
10 | use_ok('Class::MOP'); |
11 | require_ok(File::Spec->catdir('examples', 'ArrayBasedStorage.pod')); |
12 | } |
13 | |
14 | { |
15 | package Foo; |
16 | |
17 | use strict; |
18 | use warnings; |
1becdfcc |
19 | use metaclass ( |
f892c0f0 |
20 | ':instance_metaclass' => 'ArrayBasedStorage::Instance', |
21 | ); |
22 | |
23 | Foo->meta->add_attribute('foo' => ( |
24 | accessor => 'foo', |
25 | predicate => 'has_foo', |
26 | )); |
27 | |
28 | Foo->meta->add_attribute('bar' => ( |
29 | reader => 'get_bar', |
30 | writer => 'set_bar', |
31 | default => 'FOO is BAR' |
32 | )); |
33 | |
34 | sub new { |
35 | my $class = shift; |
36 | $class->meta->new_object(@_); |
37 | } |
38 | |
39 | package Bar; |
40 | |
41 | use strict; |
42 | use warnings; |
43 | |
44 | use base 'Foo'; |
45 | |
46 | Bar->meta->add_attribute('baz' => ( |
47 | accessor => 'baz', |
48 | predicate => 'has_baz', |
49 | )); |
50 | |
51 | package Baz; |
52 | |
53 | use strict; |
54 | use warnings; |
43715282 |
55 | use metaclass ( |
f892c0f0 |
56 | ':instance_metaclass' => 'ArrayBasedStorage::Instance', |
57 | ); |
58 | |
59 | Baz->meta->add_attribute('bling' => ( |
60 | accessor => 'bling', |
61 | default => 'Baz::bling' |
62 | )); |
63 | |
64 | package Bar::Baz; |
65 | |
66 | use strict; |
67 | use warnings; |
68 | |
69 | use base 'Bar', 'Baz'; |
70 | } |
71 | |
72 | my $foo = Foo->new(); |
73 | isa_ok($foo, 'Foo'); |
74 | |
75 | can_ok($foo, 'foo'); |
76 | can_ok($foo, 'has_foo'); |
77 | can_ok($foo, 'get_bar'); |
78 | can_ok($foo, 'set_bar'); |
79 | |
80 | ok(!$foo->has_foo, '... Foo::foo is not defined yet'); |
81 | is($foo->foo(), undef, '... Foo::foo is not defined yet'); |
82 | is($foo->get_bar(), 'FOO is BAR', '... Foo::bar has been initialized'); |
83 | |
84 | $foo->foo('This is Foo'); |
85 | |
86 | ok($foo->has_foo, '... Foo::foo is defined now'); |
87 | is($foo->foo(), 'This is Foo', '... Foo::foo == "This is Foo"'); |
88 | |
89 | $foo->set_bar(42); |
90 | is($foo->get_bar(), 42, '... Foo::bar == 42'); |
91 | |
92 | my $foo2 = Foo->new(); |
93 | isa_ok($foo2, 'Foo'); |
94 | |
95 | ok(!$foo2->has_foo, '... Foo2::foo is not defined yet'); |
96 | is($foo2->foo(), undef, '... Foo2::foo is not defined yet'); |
97 | is($foo2->get_bar(), 'FOO is BAR', '... Foo2::bar has been initialized'); |
98 | |
99 | $foo2->set_bar('DONT PANIC'); |
100 | is($foo2->get_bar(), 'DONT PANIC', '... Foo2::bar == DONT PANIC'); |
101 | |
102 | is($foo->get_bar(), 42, '... Foo::bar == 42'); |
103 | |
104 | # now Bar ... |
105 | |
106 | my $bar = Bar->new(); |
107 | isa_ok($bar, 'Bar'); |
108 | isa_ok($bar, 'Foo'); |
109 | |
110 | can_ok($bar, 'foo'); |
111 | can_ok($bar, 'has_foo'); |
112 | can_ok($bar, 'get_bar'); |
113 | can_ok($bar, 'set_bar'); |
114 | can_ok($bar, 'baz'); |
115 | can_ok($bar, 'has_baz'); |
116 | |
117 | ok(!$bar->has_foo, '... Bar::foo is not defined yet'); |
118 | is($bar->foo(), undef, '... Bar::foo is not defined yet'); |
119 | is($bar->get_bar(), 'FOO is BAR', '... Bar::bar has been initialized'); |
120 | ok(!$bar->has_baz, '... Bar::baz is not defined yet'); |
121 | is($bar->baz(), undef, '... Bar::baz is not defined yet'); |
122 | |
123 | $bar->foo('This is Bar::foo'); |
124 | |
125 | ok($bar->has_foo, '... Bar::foo is defined now'); |
126 | is($bar->foo(), 'This is Bar::foo', '... Bar::foo == "This is Bar"'); |
127 | is($bar->get_bar(), 'FOO is BAR', '... Bar::bar has been initialized'); |
128 | |
129 | $bar->baz('This is Bar::baz'); |
130 | |
131 | ok($bar->has_baz, '... Bar::baz is defined now'); |
132 | is($bar->baz(), 'This is Bar::baz', '... Bar::foo == "This is Bar"'); |
133 | is($bar->foo(), 'This is Bar::foo', '... Bar::foo == "This is Bar"'); |
134 | is($bar->get_bar(), 'FOO is BAR', '... Bar::bar has been initialized'); |
135 | |
136 | # now Baz ... |
137 | |
138 | my $baz = Bar::Baz->new(); |
139 | isa_ok($baz, 'Bar::Baz'); |
140 | isa_ok($baz, 'Bar'); |
141 | isa_ok($baz, 'Foo'); |
142 | isa_ok($baz, 'Baz'); |
143 | |
144 | can_ok($baz, 'foo'); |
145 | can_ok($baz, 'has_foo'); |
146 | can_ok($baz, 'get_bar'); |
147 | can_ok($baz, 'set_bar'); |
148 | can_ok($baz, 'baz'); |
149 | can_ok($baz, 'has_baz'); |
150 | can_ok($baz, 'bling'); |
151 | |
152 | is($baz->get_bar(), 'FOO is BAR', '... Bar::Baz::bar has been initialized'); |
153 | is($baz->bling(), 'Baz::bling', '... Bar::Baz::bling has been initialized'); |
154 | |
155 | ok(!$baz->has_foo, '... Bar::Baz::foo is not defined yet'); |
156 | is($baz->foo(), undef, '... Bar::Baz::foo is not defined yet'); |
157 | ok(!$baz->has_baz, '... Bar::Baz::baz is not defined yet'); |
158 | is($baz->baz(), undef, '... Bar::Baz::baz is not defined yet'); |
159 | |
160 | $baz->foo('This is Bar::Baz::foo'); |
161 | |
162 | ok($baz->has_foo, '... Bar::Baz::foo is defined now'); |
163 | is($baz->foo(), 'This is Bar::Baz::foo', '... Bar::Baz::foo == "This is Bar"'); |
164 | is($baz->get_bar(), 'FOO is BAR', '... Bar::Baz::bar has been initialized'); |
165 | is($baz->bling(), 'Baz::bling', '... Bar::Baz::bling has been initialized'); |
166 | |
167 | $baz->baz('This is Bar::Baz::baz'); |
168 | |
169 | ok($baz->has_baz, '... Bar::Baz::baz is defined now'); |
170 | is($baz->baz(), 'This is Bar::Baz::baz', '... Bar::Baz::foo == "This is Bar"'); |
171 | is($baz->foo(), 'This is Bar::Baz::foo', '... Bar::Baz::foo == "This is Bar"'); |
172 | is($baz->get_bar(), 'FOO is BAR', '... Bar::Baz::bar has been initialized'); |
173 | is($baz->bling(), 'Baz::bling', '... Bar::Baz::bling has been initialized'); |
174 | |
175 | |