X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2F108_ArrayBasedStorage_test.t;h=58ff1d45769ce418d7871ab2f2ba213ad0f918c8;hb=5e5102f19ccb1dc52b290577b0363e97dacbd5b3;hp=689c99637fc29e3ac0921dee366e17d79149ab11;hpb=f892c0f0fa293dff33f6b20826493c089a69218e;p=gitmo%2FClass-MOP.git diff --git a/t/108_ArrayBasedStorage_test.t b/t/108_ArrayBasedStorage_test.t index 689c996..58ff1d4 100644 --- a/t/108_ArrayBasedStorage_test.t +++ b/t/108_ArrayBasedStorage_test.t @@ -1,83 +1,93 @@ -#!/usr/bin/perl - use strict; use warnings; -use Test::More tests => 65; +use Test::More; use File::Spec; +use Scalar::Util 'reftype'; +use Class::MOP; -BEGIN { - use_ok('Class::MOP'); - require_ok(File::Spec->catdir('examples', 'ArrayBasedStorage.pod')); +BEGIN { + require_ok(File::Spec->catfile('examples', 'ArrayBasedStorage.pod')); } { package Foo; - + use strict; - use warnings; - use metaclass 'Class::MOP::Class' => ( - ':attribute_metaclass' => 'ArrayBasedStorage::Attribute', - ':instance_metaclass' => 'ArrayBasedStorage::Instance', + use warnings; + use metaclass ( + '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 'Class::MOP::Class' => ( - ':attribute_metaclass' => 'ArrayBasedStorage::Attribute', - ':instance_metaclass' => 'ArrayBasedStorage::Instance', + use metaclass ( + '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 +98,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 +126,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 +162,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 +195,10 @@ 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" ); +done_testing;