From: Stevan Little Date: Mon, 26 Nov 2007 21:38:51 +0000 (+0000) Subject: fixing some bugs X-Git-Tag: 0_32~8 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=f3c4e20e4056cb645da9fc64f0a248579caa70f3;p=gitmo%2FMoose.git fixing some bugs --- diff --git a/Changes b/Changes index 5f44414..620cad5 100644 --- a/Changes +++ b/Changes @@ -1,5 +1,24 @@ Revision history for Perl extension Moose +0.31 + * Moose::Meta::Attribute + - made the +attr syntax handle extending types with + parameters. So "has '+foo' => (isa => 'ArrayRef[Int]')" + now works if the original foo is an ArrayRef. + - added tests for this. + - delegation now works even if the attribute does not + have a reader method using the get_read_method_ref + method from Class::MOP::Attribute. + - added tests for this + - added docs for this + + * Moose::Util::TypeConstraints + - passing no "additional attribute info" to + &find_or_create_type_constraint will no longer + attempt to create an __ANON__ type for you, + instead it will just return undef. + - added docs for this + 0.30 Fri. Nov. 23, 2007 * Moose::Meta::Method::Constructor -builder related bug in inlined constructor. (groditi) diff --git a/Makefile.PL b/Makefile.PL index cb6139f..c9c0544 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -12,7 +12,7 @@ my $win32 = !! ( $^O eq 'Win32' or $^O eq 'cygwin' ); # prereqs requires 'Scalar::Util' => $win32 ? '1.17' : '1.18'; requires 'Carp'; -requires 'Class::MOP' => '0.46'; +requires 'Class::MOP' => '0.47'; requires 'Sub::Name' => '0.02'; requires 'Sub::Exporter' => '0.972'; requires 'B'; diff --git a/README b/README index d39ad82..32e9610 100644 --- a/README +++ b/README @@ -1,4 +1,4 @@ -Moose version 0.30 +Moose version 0.31 =========================== See the individual module documentation for more information diff --git a/lib/Moose.pm b/lib/Moose.pm index f251bcf..ed365ce 100644 --- a/lib/Moose.pm +++ b/lib/Moose.pm @@ -4,7 +4,7 @@ package Moose; use strict; use warnings; -our $VERSION = '0.30'; +our $VERSION = '0.31'; our $AUTHORITY = 'cpan:STEVAN'; use Scalar::Util 'blessed', 'reftype'; @@ -492,6 +492,11 @@ almost never want to do this, since it usually breaks your class. As with overriding locally defined methods, if you do want to do this, you should do it manually, not with Moose. +You do not I to have a reader (or accessor) for the attribute in order +to delegate to it. Moose will create a means of accessing the value for you, +however this will be several times B efficient then if you had given +the attribute a reader (or accessor) to use. + Below is the documentation for each option format: =over 4 diff --git a/lib/Moose/Meta/Attribute.pm b/lib/Moose/Meta/Attribute.pm index bcb095c..5f3b8bb 100644 --- a/lib/Moose/Meta/Attribute.pm +++ b/lib/Moose/Meta/Attribute.pm @@ -8,7 +8,7 @@ use Scalar::Util 'blessed', 'weaken', 'reftype'; use Carp 'confess'; use overload (); -our $VERSION = '0.14'; +our $VERSION = '0.15'; our $AUTHORITY = 'cpan:STEVAN'; use Moose::Meta::Method::Accessor; @@ -47,9 +47,9 @@ __PACKAGE__->meta->add_attribute('documentation' => ( )); sub new { - my ($class, $name, %options) = @_; - $class->_process_options($name, \%options); - return $class->SUPER::new($name, %options); + my ($class, $name, %options) = @_; + $class->_process_options($name, \%options); + return $class->SUPER::new($name, %options); } sub clone_and_inherit_options { @@ -79,7 +79,9 @@ sub clone_and_inherit_options { $type_constraint = $options{isa}; } else { - $type_constraint = Moose::Util::TypeConstraints::find_type_constraint($options{isa}); + $type_constraint = Moose::Util::TypeConstraints::find_or_create_type_constraint( + $options{isa} + ); (defined $type_constraint) || confess "Could not find the type constraint '" . $options{isa} . "'"; } @@ -101,98 +103,98 @@ sub clone_and_inherit_options { sub _process_options { my ($class, $name, $options) = @_; - - if (exists $options->{is}) { - if ($options->{is} eq 'ro') { - $options->{reader} ||= $name; - (!exists $options->{trigger}) - || confess "Cannot have a trigger on a read-only attribute"; - } - elsif ($options->{is} eq 'rw') { - $options->{accessor} = $name; - ((reftype($options->{trigger}) || '') eq 'CODE') - || confess "Trigger must be a CODE ref" - if exists $options->{trigger}; - } - else { - confess "I do not understand this option (is => " . $options->{is} . ")" - } - } - - if (exists $options->{isa}) { - - if (exists $options->{does}) { - if (eval { $options->{isa}->can('does') }) { - ($options->{isa}->does($options->{does})) - || confess "Cannot have an isa option and a does option if the isa does not do the does"; - } - else { - confess "Cannot have an isa option which cannot ->does()"; - } + + if (exists $options->{is}) { + if ($options->{is} eq 'ro') { + $options->{reader} ||= $name; + (!exists $options->{trigger}) + || confess "Cannot have a trigger on a read-only attribute"; + } + elsif ($options->{is} eq 'rw') { + $options->{accessor} = $name; + ((reftype($options->{trigger}) || '') eq 'CODE') + || confess "Trigger must be a CODE ref" + if exists $options->{trigger}; + } + else { + confess "I do not understand this option (is => " . $options->{is} . ")" + } + } + + if (exists $options->{isa}) { + + if (exists $options->{does}) { + if (eval { $options->{isa}->can('does') }) { + ($options->{isa}->does($options->{does})) + || confess "Cannot have an isa option and a does option if the isa does not do the does"; + } + else { + confess "Cannot have an isa option which cannot ->does()"; } - - # allow for anon-subtypes here ... - if (blessed($options->{isa}) && $options->{isa}->isa('Moose::Meta::TypeConstraint')) { - $options->{type_constraint} = $options->{isa}; - } - else { - $options->{type_constraint} = Moose::Util::TypeConstraints::find_or_create_type_constraint( - $options->{isa} => { - parent => Moose::Util::TypeConstraints::find_type_constraint('Object'), - constraint => sub { $_[0]->isa($options->{isa}) } - } - ); - } } - elsif (exists $options->{does}) { - # allow for anon-subtypes here ... - if (blessed($options->{does}) && $options->{does}->isa('Moose::Meta::TypeConstraint')) { - $options->{type_constraint} = $options->{isa}; + + # allow for anon-subtypes here ... + if (blessed($options->{isa}) && $options->{isa}->isa('Moose::Meta::TypeConstraint')) { + $options->{type_constraint} = $options->{isa}; + } + else { + $options->{type_constraint} = Moose::Util::TypeConstraints::find_or_create_type_constraint( + $options->{isa} => { + parent => Moose::Util::TypeConstraints::find_type_constraint('Object'), + constraint => sub { $_[0]->isa($options->{isa}) } } - else { - $options->{type_constraint} = Moose::Util::TypeConstraints::find_or_create_type_constraint( - $options->{does} => { - parent => Moose::Util::TypeConstraints::find_type_constraint('Role'), - constraint => sub { $_[0]->does($options->{does}) } - } - ); + ); + } + } + elsif (exists $options->{does}) { + # allow for anon-subtypes here ... + if (blessed($options->{does}) && $options->{does}->isa('Moose::Meta::TypeConstraint')) { + $options->{type_constraint} = $options->{isa}; + } + else { + $options->{type_constraint} = Moose::Util::TypeConstraints::find_or_create_type_constraint( + $options->{does} => { + parent => Moose::Util::TypeConstraints::find_type_constraint('Role'), + constraint => sub { $_[0]->does($options->{does}) } } - } - - if (exists $options->{coerce} && $options->{coerce}) { - (exists $options->{type_constraint}) - || confess "You cannot have coercion without specifying a type constraint"; - confess "You cannot have a weak reference to a coerced value" - if $options->{weak_ref}; - } - - if (exists $options->{auto_deref} && $options->{auto_deref}) { - (exists $options->{type_constraint}) - || confess "You cannot auto-dereference without specifying a type constraint"; - ($options->{type_constraint}->is_a_type_of('ArrayRef') || - $options->{type_constraint}->is_a_type_of('HashRef')) - || confess "You cannot auto-dereference anything other than a ArrayRef or HashRef"; - } - - if (exists $options->{lazy_build} && $options->{lazy_build} == 1) { - confess("You can not use lazy_build and default for the same attribute") - if exists $options->{default}; - $options->{lazy} = 1; - $options->{required} = 1; - $options->{builder} ||= "_build_${name}"; - if($name =~ /^_/){ - $options->{clearer} ||= "_clear${name}"; - $options->{predicate} ||= "_has${name}"; - } else { - $options->{clearer} ||= "clear_${name}"; - $options->{predicate} ||= "has_${name}"; + ); } + } + + if (exists $options->{coerce} && $options->{coerce}) { + (exists $options->{type_constraint}) + || confess "You cannot have coercion without specifying a type constraint"; + confess "You cannot have a weak reference to a coerced value" + if $options->{weak_ref}; + } + + if (exists $options->{auto_deref} && $options->{auto_deref}) { + (exists $options->{type_constraint}) + || confess "You cannot auto-dereference without specifying a type constraint"; + ($options->{type_constraint}->is_a_type_of('ArrayRef') || + $options->{type_constraint}->is_a_type_of('HashRef')) + || confess "You cannot auto-dereference anything other than a ArrayRef or HashRef"; + } + + if (exists $options->{lazy_build} && $options->{lazy_build} == 1) { + confess("You can not use lazy_build and default for the same attribute") + if exists $options->{default}; + $options->{lazy} = 1; + $options->{required} = 1; + $options->{builder} ||= "_build_${name}"; + if($name =~ /^_/){ + $options->{clearer} ||= "_clear${name}"; + $options->{predicate} ||= "_has${name}"; + } else { + $options->{clearer} ||= "clear_${name}"; + $options->{predicate} ||= "has_${name}"; } - - if (exists $options->{lazy} && $options->{lazy}) { - (exists $options->{default} || exists $options->{builder} ) - || confess "You cannot have lazy attribute without specifying a default value for it"; - } + } + + if (exists $options->{lazy} && $options->{lazy}) { + (exists $options->{default} || exists $options->{builder} ) + || confess "You cannot have lazy attribute without specifying a default value for it"; + } } @@ -365,14 +367,10 @@ sub install_accessors { # to delagate to, see that method for details my %handles = $self->_canonicalize_handles(); - # find the name of the accessor for this attribute - my $accessor_name = $self->reader || $self->accessor; - (defined $accessor_name) - || confess "You cannot install delegation without a reader or accessor for the attribute"; - - # make sure we handle HASH accessors correctly - ($accessor_name) = keys %{$accessor_name} - if ref($accessor_name) eq 'HASH'; + # find the accessor method for this attribute + my $accessor = $self->get_read_method_ref; + # then unpack it if we need too ... + $accessor = $accessor->body if blessed $accessor; # install the delegation ... my $associated_class = $self->associated_class; @@ -398,9 +396,9 @@ sub install_accessors { # we should check for lack of # a callable return value from # the accessor here - my $proxy = (shift)->$accessor_name(); + my $proxy = (shift)->$accessor(); @_ = ($proxy, @_); - goto &{ $proxy->can($method_to_call)}; + goto &{ $proxy->can($method_to_call) }; }); } } diff --git a/lib/Moose/Util/TypeConstraints.pm b/lib/Moose/Util/TypeConstraints.pm index f144a57..9bef612 100644 --- a/lib/Moose/Util/TypeConstraints.pm +++ b/lib/Moose/Util/TypeConstraints.pm @@ -164,6 +164,12 @@ sub find_or_create_type_constraint ($;$) { } else { # NOTE: + # if there is no $options_for_anon_type + # specified, then we assume they don't + # want to create one, and return nothing. + return unless defined $options_for_anon_type; + + # NOTE: # otherwise assume that we should create # an ANON type with the $options_for_anon_type # options which can be passed in. It should @@ -618,7 +624,9 @@ This will attempt to find or create a type constraint given the a C<$type_name>. If it cannot find it in the registry, it will see if it should be a union or container type an create one if appropriate, and lastly if nothing can be found or created that way, it will create an anon-type using the -C<$options_for_anon_type> HASH ref to populate it. +C<$options_for_anon_type> HASH ref to populate it. If the C<$options_for_anon_type> +is not specified (it is C), then it will not create anything and simply +return. =item B diff --git a/t/020_attributes/009_attribute_inherited_slot_specs.t b/t/020_attributes/009_attribute_inherited_slot_specs.t index 791f042..02b52fb 100644 --- a/t/020_attributes/009_attribute_inherited_slot_specs.t +++ b/t/020_attributes/009_attribute_inherited_slot_specs.t @@ -3,7 +3,7 @@ use strict; use warnings; -use Test::More tests => 72; +use Test::More tests => 80; use Test::Exception; BEGIN { @@ -39,6 +39,8 @@ BEGIN { has 'bling' => (is => 'ro', isa => 'Thing'); has 'blang' => (is => 'ro', isa => 'Thing', handles => ['goodbye']); + has 'bunch_of_stuff' => (is => 'rw', isa => 'ArrayRef'); + # this one will work here .... has 'fail' => (isa => 'CodeRef'); has 'other_fail'; @@ -67,6 +69,10 @@ BEGIN { ::lives_ok { has '+gloum' => (lazy => 1); } '... we can change/add lazy as an attribute option'; + + ::lives_ok { + has '+bunch_of_stuff' => (isa => 'ArrayRef[Int]'); + } '... extend an attribute with parameterized type'; ::lives_ok { has '+bling' => (handles => ['hello']); @@ -115,6 +121,8 @@ is($foo->baz, undef, '... got the right undef default value'); lives_ok { $foo->baz($scalar_ref) } '... Foo::baz accepts scalar ref'; is($foo->baz, $scalar_ref, '... got the right value assigned to baz'); + lives_ok { $foo->bunch_of_stuff([qw[one two three]]) } '... Foo::bunch_of_stuff accepts an array of strings'; + my $code_ref = sub { 1 }; lives_ok { $foo->baz($code_ref) } '... Foo::baz accepts a code ref'; is($foo->baz, $code_ref, '... got the right value assigned to baz'); @@ -152,6 +160,9 @@ is($bar->baz, undef, '... got the right undef default value'); my $scalar_ref = \(my $var); dies_ok { $bar->baz($scalar_ref) } '... Bar::baz does not accept a scalar ref'; + lives_ok { $bar->bunch_of_stuff([1, 2, 3]) } '... Bar::bunch_of_stuff accepts an array of ints'; + dies_ok { $bar->bunch_of_stuff([qw[one two three]]) } '... Bar::bunch_of_stuff does not accept an array of strings'; + my $code_ref = sub { 1 }; dies_ok { $bar->baz($code_ref) } '... Bar::baz does not accept a code ref'; } @@ -164,6 +175,7 @@ ok(Bar->meta->has_attribute('baz'), '... Bar has a baz attr'); ok(Bar->meta->has_attribute('gorch'), '... Bar has a gorch attr'); ok(Bar->meta->has_attribute('gloum'), '... Bar has a gloum attr'); ok(Bar->meta->has_attribute('bling'), '... Bar has a bling attr'); +ok(Bar->meta->has_attribute('bunch_of_stuff'), '... Bar does have a bunch_of_stuff attr'); ok(!Bar->meta->has_attribute('blang'), '... Bar has a blang attr'); ok(!Bar->meta->has_attribute('fail'), '... Bar does not have a fail attr'); ok(!Bar->meta->has_attribute('other_fail'), '... Bar does not have a fail attr'); @@ -186,6 +198,9 @@ isnt(Foo->meta->get_attribute('gloum'), isnt(Foo->meta->get_attribute('bling'), Bar->meta->get_attribute('bling'), '... Foo and Bar have different copies of bling'); +isnt(Foo->meta->get_attribute('bunch_of_stuff'), + Bar->meta->get_attribute('bunch_of_stuff'), + '... Foo and Bar have different copies of bunch_of_stuff'); ok(Bar->meta->get_attribute('bar')->has_type_constraint, '... Bar::bar inherited the type constraint too'); @@ -205,6 +220,13 @@ ok(!Foo->meta->get_attribute('gorch')->is_required, ok(Bar->meta->get_attribute('gorch')->is_required, '... Bar::gorch is a required attr'); +is(Foo->meta->get_attribute('bunch_of_stuff')->type_constraint->name, + 'ArrayRef', + '... Foo::bunch_of_stuff is an ArrayRef'); +is(Bar->meta->get_attribute('bunch_of_stuff')->type_constraint->name, + 'ArrayRef[Int]', + '... Bar::bunch_of_stuff is an ArrayRef[Int]'); + ok(!Foo->meta->get_attribute('gloum')->is_lazy, '... Foo::gloum is not a required attr'); ok(Bar->meta->get_attribute('gloum')->is_lazy, diff --git a/t/020_attributes/011_more_attr_delegation.t b/t/020_attributes/011_more_attr_delegation.t index 10d5e8c..4445908 100644 --- a/t/020_attributes/011_more_attr_delegation.t +++ b/t/020_attributes/011_more_attr_delegation.t @@ -3,7 +3,7 @@ use strict; use warnings; -use Test::More tests => 35; +use Test::More tests => 39; use Test::Exception; { @@ -63,6 +63,11 @@ use Test::Exception; sub child_f_method_1 { "f1" } sub child_f_method_2 { "f2" } + package ChildG; + use Moose; + + sub child_g_method_1 { "g1" } + package Parent; use Moose; @@ -145,6 +150,14 @@ use Test::Exception; } "subrefs on non moose class give no meta"; ::is( $delegate_class, "ChildF", "plain classes are handed down to subs" ); + + ::lives_ok { + has child_g => ( + isa => "ChildG", + default => sub { ChildG->new }, + handles => ["child_g_method_1"], + ); + } "can delegate to object even without explicit reader"; sub parent_method { "p" } } @@ -159,6 +172,8 @@ isa_ok( $p->child_d, "ChildD" ); isa_ok( $p->child_e, "ChildE" ); isa_ok( $p->child_f, "ChildF" ); +ok(!$p->can('child_g'), '... no child_g accessor defined'); + is( $p->parent_method, "p", "parent method" ); is( $p->child_a->child_a_super_method, "as", "child supermethod" ); @@ -189,3 +204,6 @@ can_ok( $p, "child_e_method_2" ); ok( !$p->can("child_e_method_1"), "but not child_e_method_1"); is( $p->child_e_method_2, "e2", "delegate to non moose class (child_e_method_2)" ); + +can_ok( $p, "child_g_method_1" ); +is( $p->child_g_method_1, "g1", "delegate to moose class without reader (child_g_method_1)" );