From: ewilhelm Date: Sat, 5 Aug 2006 22:27:53 +0000 (+0000) Subject: t/001_basic.t - add ro test X-Git-Tag: 0_01~9 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=gitmo%2FMoose-Policy.git;a=commitdiff_plain;h=bfacd619d119a4262f60eadcb431fae0cde270a1 t/001_basic.t - add ro test lib/Moose/Policy.pm - check for the big three metaclass delegations --- diff --git a/lib/Moose/Policy.pm b/lib/Moose/Policy.pm index ffe4b69..4cb790e 100644 --- a/lib/Moose/Policy.pm +++ b/lib/Moose/Policy.pm @@ -25,10 +25,17 @@ sub import { my %options; - $options{':attribute_metaclass'} = $policy->attribute_metaclass - if $policy->can('attribute_metaclass'); + # build options out of policy's constants + $policy->can($_) and $options{":$_"} = $policy->$_() + for (qw( + attribute_metaclass + instance_metaclass + method_metaclass + )); my $package = caller(); + $package->can('meta') and + croak("'$package' already has a meta() method"); # create a meta object so we can install &meta my $meta = $metaclass->initialize($package => %options); @@ -46,3 +53,4 @@ sub import { __END__ + diff --git a/t/001_basic.t b/t/001_basic.t index 867445b..fced719 100644 --- a/t/001_basic.t +++ b/t/001_basic.t @@ -3,7 +3,7 @@ use strict; use warnings; -use Test::More tests => 8; +use Test::More 'no_plan'; BEGIN { use_ok('Moose::Policy'); @@ -15,6 +15,8 @@ BEGIN { extends 'Moose::Meta::Attribute'; + # this method (mostly stolen from M::M::Attribute) just rebuilds the + # options so anything with 'is' gets PBP accessors sub _process_options { my ($class, $name, $options) = @_; if (exists $options->{is}) { @@ -34,6 +36,7 @@ BEGIN { { package My::Moose::Policy; + # policy just specifies metaclass delegates use constant attribute_metaclass => 'My::Moose::Meta::Attribute'; } @@ -44,6 +47,7 @@ BEGIN { use Moose; has 'bar' => (is => 'rw', default => 'Foo::bar'); + has 'baz' => (is => 'ro', default => 'Foo::baz'); } isa_ok(Foo->meta, 'Moose::Meta::Class'); @@ -57,7 +61,10 @@ isa_ok($foo, 'Foo'); can_ok($foo, 'get_bar'); can_ok($foo, 'set_bar'); +can_ok($foo, 'get_baz'); + is($foo->get_bar, 'Foo::bar', '... got the right default value'); +is($foo->get_baz, 'Foo::baz', '... got the right default value');