X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2F108_ArrayBasedStorage_test.t;h=f47b010a9666ca4f1c6f23aa4200d54ed20a1488;hb=33ecbaa40bbcda7518cb3e5477d357e6b3d95ff6;hp=a7b24e9f44e737c3a25922fbb684efd5ef6cf83b;hpb=c54756cda0ab48bb660c5c1429ace8b5aafbb304;p=gitmo%2FClass-MOP.git diff --git a/t/108_ArrayBasedStorage_test.t b/t/108_ArrayBasedStorage_test.t index a7b24e9..f47b010 100644 --- a/t/108_ArrayBasedStorage_test.t +++ b/t/108_ArrayBasedStorage_test.t @@ -1,83 +1,92 @@ -#!/usr/bin/perl - use strict; use warnings; -use Test::More tests => 65; +use Test::More tests => 72; use File::Spec; +use Scalar::Util 'reftype'; -BEGIN { - use_ok('Class::MOP'); - require_ok(File::Spec->catdir('examples', 'ArrayBasedStorage.pod')); +BEGIN {use Class::MOP; + require_ok(File::Spec->catfile('examples', 'ArrayBasedStorage.pod')); } { package Foo; - + use strict; - use warnings; + use warnings; use metaclass ( - ':attribute_metaclass' => 'ArrayBasedStorage::Attribute', - ':instance_metaclass' => 'ArrayBasedStorage::Instance', + 'instance_metaclass' => 'ArrayBasedStorage::Instance', ); - + Foo->meta->add_attribute('foo' => ( accessor => 'foo', + clearer => 'clear_foo', predicate => 'has_foo', )); - + Foo->meta->add_attribute('bar' => ( reader => 'get_bar', writer => 'set_bar', - default => 'FOO is BAR' + default => 'FOO is BAR' )); - + sub new { my $class = shift; $class->meta->new_object(@_); } - + package Bar; - + use metaclass ( + 'instance_metaclass' => 'ArrayBasedStorage::Instance', + ); + use strict; use warnings; - + use base 'Foo'; - + Bar->meta->add_attribute('baz' => ( accessor => 'baz', predicate => 'has_baz', - )); - + )); + package Baz; - + use metaclass ( + 'instance_metaclass' => 'ArrayBasedStorage::Instance', + ); + use strict; use warnings; use metaclass ( - ':attribute_metaclass' => 'ArrayBasedStorage::Attribute', - ':instance_metaclass' => 'ArrayBasedStorage::Instance', + 'instance_metaclass' => 'ArrayBasedStorage::Instance', ); - + Baz->meta->add_attribute('bling' => ( accessor => 'bling', default => 'Baz::bling' - )); - + )); + package Bar::Baz; - + use metaclass ( + 'instance_metaclass' => 'ArrayBasedStorage::Instance', + ); + use strict; use warnings; - - use base 'Bar', 'Baz'; + + use base 'Bar', 'Baz'; } my $foo = Foo->new(); isa_ok($foo, 'Foo'); +is(reftype($foo), 'ARRAY', '... Foo is made with ARRAY'); + can_ok($foo, 'foo'); can_ok($foo, 'has_foo'); can_ok($foo, 'get_bar'); can_ok($foo, 'set_bar'); +can_ok($foo, 'clear_foo'); ok(!$foo->has_foo, '... Foo::foo is not defined yet'); is($foo->foo(), undef, '... Foo::foo is not defined yet'); @@ -88,12 +97,19 @@ $foo->foo('This is Foo'); ok($foo->has_foo, '... Foo::foo is defined now'); is($foo->foo(), 'This is Foo', '... Foo::foo == "This is Foo"'); +$foo->clear_foo; + +ok(!$foo->has_foo, '... Foo::foo is not defined anymore'); +is($foo->foo(), undef, '... Foo::foo is not defined anymore'); + $foo->set_bar(42); is($foo->get_bar(), 42, '... Foo::bar == 42'); my $foo2 = Foo->new(); isa_ok($foo2, 'Foo'); +is(reftype($foo2), 'ARRAY', '... Foo is made with ARRAY'); + ok(!$foo2->has_foo, '... Foo2::foo is not defined yet'); is($foo2->foo(), undef, '... Foo2::foo is not defined yet'); is($foo2->get_bar(), 'FOO is BAR', '... Foo2::bar has been initialized'); @@ -109,6 +125,8 @@ my $bar = Bar->new(); isa_ok($bar, 'Bar'); isa_ok($bar, 'Foo'); +is(reftype($bar), 'ARRAY', '... Bar is made with ARRAY'); + can_ok($bar, 'foo'); can_ok($bar, 'has_foo'); can_ok($bar, 'get_bar'); @@ -143,6 +161,8 @@ isa_ok($baz, 'Bar'); isa_ok($baz, 'Foo'); isa_ok($baz, 'Baz'); +is(reftype($baz), 'ARRAY', '... Bar::Baz is made with ARRAY'); + can_ok($baz, 'foo'); can_ok($baz, 'has_foo'); can_ok($baz, 'get_bar'); @@ -174,4 +194,9 @@ is($baz->foo(), 'This is Bar::Baz::foo', '... Bar::Baz::foo == "This is Bar"'); is($baz->get_bar(), 'FOO is BAR', '... Bar::Baz::bar has been initialized'); is($baz->bling(), 'Baz::bling', '... Bar::Baz::bling has been initialized'); +Foo->meta->add_attribute( forgotten => is => "rw" ); + +my $new_baz = Bar::Baz->new; + +cmp_ok( scalar(@$new_baz), ">", scalar(@$baz), "additional slot due to refreshed meta instance" );