6 use Scalar::Util 'reftype';
10 require_ok(File::Spec->catfile('examples', 'ArrayBasedStorage.pod'));
19 'instance_metaclass' => 'ArrayBasedStorage::Instance',
22 Foo->meta->add_attribute('foo' => (
24 clearer => 'clear_foo',
25 predicate => 'has_foo',
28 Foo->meta->add_attribute('bar' => (
31 default => 'FOO is BAR'
36 $class->meta->new_object(@_);
41 'instance_metaclass' => 'ArrayBasedStorage::Instance',
49 Bar->meta->add_attribute('baz' => (
51 predicate => 'has_baz',
56 'instance_metaclass' => 'ArrayBasedStorage::Instance',
62 'instance_metaclass' => 'ArrayBasedStorage::Instance',
65 Baz->meta->add_attribute('bling' => (
67 default => 'Baz::bling'
72 'instance_metaclass' => 'ArrayBasedStorage::Instance',
78 use base 'Bar', 'Baz';
84 is(reftype($foo), 'ARRAY', '... Foo is made with ARRAY');
87 can_ok($foo, 'has_foo');
88 can_ok($foo, 'get_bar');
89 can_ok($foo, 'set_bar');
90 can_ok($foo, 'clear_foo');
92 ok(!$foo->has_foo, '... Foo::foo is not defined yet');
93 is($foo->foo(), undef, '... Foo::foo is not defined yet');
94 is($foo->get_bar(), 'FOO is BAR', '... Foo::bar has been initialized');
96 $foo->foo('This is Foo');
98 ok($foo->has_foo, '... Foo::foo is defined now');
99 is($foo->foo(), 'This is Foo', '... Foo::foo == "This is Foo"');
103 ok(!$foo->has_foo, '... Foo::foo is not defined anymore');
104 is($foo->foo(), undef, '... Foo::foo is not defined anymore');
107 is($foo->get_bar(), 42, '... Foo::bar == 42');
109 my $foo2 = Foo->new();
110 isa_ok($foo2, 'Foo');
112 is(reftype($foo2), 'ARRAY', '... Foo is made with ARRAY');
114 ok(!$foo2->has_foo, '... Foo2::foo is not defined yet');
115 is($foo2->foo(), undef, '... Foo2::foo is not defined yet');
116 is($foo2->get_bar(), 'FOO is BAR', '... Foo2::bar has been initialized');
118 $foo2->set_bar('DONT PANIC');
119 is($foo2->get_bar(), 'DONT PANIC', '... Foo2::bar == DONT PANIC');
121 is($foo->get_bar(), 42, '... Foo::bar == 42');
125 my $bar = Bar->new();
129 is(reftype($bar), 'ARRAY', '... Bar is made with ARRAY');
132 can_ok($bar, 'has_foo');
133 can_ok($bar, 'get_bar');
134 can_ok($bar, 'set_bar');
136 can_ok($bar, 'has_baz');
138 ok(!$bar->has_foo, '... Bar::foo is not defined yet');
139 is($bar->foo(), undef, '... Bar::foo is not defined yet');
140 is($bar->get_bar(), 'FOO is BAR', '... Bar::bar has been initialized');
141 ok(!$bar->has_baz, '... Bar::baz is not defined yet');
142 is($bar->baz(), undef, '... Bar::baz is not defined yet');
144 $bar->foo('This is Bar::foo');
146 ok($bar->has_foo, '... Bar::foo is defined now');
147 is($bar->foo(), 'This is Bar::foo', '... Bar::foo == "This is Bar"');
148 is($bar->get_bar(), 'FOO is BAR', '... Bar::bar has been initialized');
150 $bar->baz('This is Bar::baz');
152 ok($bar->has_baz, '... Bar::baz is defined now');
153 is($bar->baz(), 'This is Bar::baz', '... Bar::foo == "This is Bar"');
154 is($bar->foo(), 'This is Bar::foo', '... Bar::foo == "This is Bar"');
155 is($bar->get_bar(), 'FOO is BAR', '... Bar::bar has been initialized');
159 my $baz = Bar::Baz->new();
160 isa_ok($baz, 'Bar::Baz');
165 is(reftype($baz), 'ARRAY', '... Bar::Baz is made with ARRAY');
168 can_ok($baz, 'has_foo');
169 can_ok($baz, 'get_bar');
170 can_ok($baz, 'set_bar');
172 can_ok($baz, 'has_baz');
173 can_ok($baz, 'bling');
175 is($baz->get_bar(), 'FOO is BAR', '... Bar::Baz::bar has been initialized');
176 is($baz->bling(), 'Baz::bling', '... Bar::Baz::bling has been initialized');
178 ok(!$baz->has_foo, '... Bar::Baz::foo is not defined yet');
179 is($baz->foo(), undef, '... Bar::Baz::foo is not defined yet');
180 ok(!$baz->has_baz, '... Bar::Baz::baz is not defined yet');
181 is($baz->baz(), undef, '... Bar::Baz::baz is not defined yet');
183 $baz->foo('This is Bar::Baz::foo');
185 ok($baz->has_foo, '... Bar::Baz::foo is defined now');
186 is($baz->foo(), 'This is Bar::Baz::foo', '... Bar::Baz::foo == "This is Bar"');
187 is($baz->get_bar(), 'FOO is BAR', '... Bar::Baz::bar has been initialized');
188 is($baz->bling(), 'Baz::bling', '... Bar::Baz::bling has been initialized');
190 $baz->baz('This is Bar::Baz::baz');
192 ok($baz->has_baz, '... Bar::Baz::baz is defined now');
193 is($baz->baz(), 'This is Bar::Baz::baz', '... Bar::Baz::foo == "This is Bar"');
194 is($baz->foo(), 'This is Bar::Baz::foo', '... Bar::Baz::foo == "This is Bar"');
195 is($baz->get_bar(), 'FOO is BAR', '... Bar::Baz::bar has been initialized');
196 is($baz->bling(), 'Baz::bling', '... Bar::Baz::bling has been initialized');
198 Foo->meta->add_attribute( forgotten => is => "rw" );
200 my $new_baz = Bar::Baz->new;
202 cmp_ok( scalar(@$new_baz), ">", scalar(@$baz), "additional slot due to refreshed meta instance" );