X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2F108_ArrayBasedStorage_test.t;h=f47b010a9666ca4f1c6f23aa4200d54ed20a1488;hb=41fc2d0fd29483cb704e06198bfaabbcd3e09d08;hp=c36a11186420db0bc689fcd50f658796bf44cfaa;hpb=88dd563c8b2edea359b8500535b8b46a8bbe6340;p=gitmo%2FClass-MOP.git diff --git a/t/108_ArrayBasedStorage_test.t b/t/108_ArrayBasedStorage_test.t index c36a111..f47b010 100644 --- a/t/108_ArrayBasedStorage_test.t +++ b/t/108_ArrayBasedStorage_test.t @@ -1,73 +1,80 @@ -#!/usr/bin/perl - use strict; use warnings; -use Test::More tests => 69; +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 ( - ':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 ( - ':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(); @@ -79,6 +86,7 @@ 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'); @@ -89,6 +97,11 @@ $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'); @@ -181,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" );