From: Yuval Kogman Date: Sat, 6 May 2006 12:03:33 +0000 (+0000) Subject: auto_deref X-Git-Tag: 0_09_03~39 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=1a5632432dc07b9c1c07c6a29342f51172a6d439;p=gitmo%2FMoose.git auto_deref --- diff --git a/TODO b/TODO index b709e2d..98fd5f6 100644 --- a/TODO +++ b/TODO @@ -60,8 +60,6 @@ and that if this usage style is used nothing is exported to the namespace. - default should dclone() -- auto_deref => 1 for auto-de-refing ARRAY and HASH attrs - - subtype $anon_subtype => where { ... } [22:56] stevan sub mst_doesnt_like_to_type { (shift)->meta->attr->type_contstraint } diff --git a/lib/Moose/Meta/Attribute.pm b/lib/Moose/Meta/Attribute.pm index d5e3b8f..e441481 100644 --- a/lib/Moose/Meta/Attribute.pm +++ b/lib/Moose/Meta/Attribute.pm @@ -13,10 +13,11 @@ use Moose::Util::TypeConstraints (); use base 'Class::MOP::Attribute'; -__PACKAGE__->meta->add_attribute('required' => (reader => 'is_required' )); -__PACKAGE__->meta->add_attribute('lazy' => (reader => 'is_lazy' )); -__PACKAGE__->meta->add_attribute('coerce' => (reader => 'should_coerce')); -__PACKAGE__->meta->add_attribute('weak_ref' => (reader => 'is_weak_ref' )); +__PACKAGE__->meta->add_attribute('required' => (reader => 'is_required' )); +__PACKAGE__->meta->add_attribute('lazy' => (reader => 'is_lazy' )); +__PACKAGE__->meta->add_attribute('coerce' => (reader => 'should_coerce' )); +__PACKAGE__->meta->add_attribute('weak_ref' => (reader => 'is_weak_ref' )); +__PACKAGE__->meta->add_attribute('auto_deref' => (reader => 'should_auto_deref')); __PACKAGE__->meta->add_attribute('type_constraint' => ( reader => 'type_constraint', predicate => 'has_type_constraint', @@ -239,6 +240,25 @@ sub _inline_get { return $mi->inline_get_slot_value($instance, $slot_name); } +sub _inline_auto_deref { + my ( $self, $ref_value ) = @_; + + return $ref_value unless $self->should_auto_deref; + + my $type = eval { $self->type_constraint->name } || ''; + my $sigil; + + if ( $type eq "ArrayRef" ) { + $sigil = '@'; + } elsif ( $type eq 'HashRef' ) { + $sigil = '%'; + } else { + confess "Can't auto deref unless type constraint is ArrayRef or HashRef"; + } + + "(wantarray() ? $sigil\{ ( $ref_value ) || return } : ( $ref_value ) )"; +} + sub generate_accessor_method { my ($attr, $attr_name) = @_; my $value_name = $attr->should_coerce ? '$val' : '$_[1]'; @@ -261,7 +281,7 @@ sub generate_accessor_method { '$_[0]->{$attr_name} = ($attr->has_default ? $attr->default($_[0]) : undef)' . 'unless exists $_[0]->{$attr_name};' : '') - . 'return ' . $attr->_inline_get( $inv ) + . 'return ' . $attr->_inline_auto_deref( $attr->_inline_get( $inv ) ) . ' }'; my $sub = eval $code; warn "Could not create accessor for '$attr_name' because $@ \n code: $code" if $@; @@ -298,7 +318,7 @@ sub generate_reader_method { '$_[0]->{$attr_name} = ($self->has_default ? $self->default($_[0]) : undef)' . 'unless exists $_[0]->{$attr_name};' : '') - . 'return $_[0]->{$attr_name};' + . 'return ' . $self->_inline_auto_deref( '$_[0]->{$attr_name}' ) . ';' . '}'; my $sub = eval $code; confess "Could not create reader for '$attr_name' because $@ \n code: $code" if $@; diff --git a/lib/Moose/Meta/Class.pm b/lib/Moose/Meta/Class.pm index c4a78a3..5bf56a4 100644 --- a/lib/Moose/Meta/Class.pm +++ b/lib/Moose/Meta/Class.pm @@ -123,7 +123,7 @@ sub generate_delgate_method { # FIXME the reader may not work for subclasses with weird instances my $make = $method->{generator} || sub { - my ( $self, $attr, $method ) =@_; + my ( $self, $attr, $method ) = @_; my $method_name = $method->{name}; my $reader = $attr->generate_reader_method(); @@ -372,3 +372,4 @@ This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut + diff --git a/t/032_attribute_accessor_generation.t b/t/032_attribute_accessor_generation.t index 385134d..5bbc1fa 100644 --- a/t/032_attribute_accessor_generation.t +++ b/t/032_attribute_accessor_generation.t @@ -3,7 +3,7 @@ use strict; use warnings; -use Test::More tests => 33; +use Test::More tests => 57; use Test::Exception; use Scalar::Util 'isweak'; @@ -58,6 +58,33 @@ BEGIN { ); }; ::ok(!$@, '... created the accessor method with weak_ref okay'); + + eval { + has 'foo_deref' => ( + accessor => 'foo_deref', + isa => 'ArrayRef', + auto_deref => 1, + ); + }; + ::ok(!$@, '... created the accessor method with auto_deref okay'); + + eval { + has 'foo_deref_ro' => ( + reader => 'foo_deref_ro', + isa => 'ArrayRef', + auto_deref => 1, + ); + }; + ::ok(!$@, '... created the reader method with auto_deref okay'); + + eval { + has 'foo_deref_hash' => ( + accessor => 'foo_deref_hash', + isa => 'HashRef', + auto_deref => 1, + ); + }; + ::ok(!$@, '... created the reader method with auto_deref okay'); } { @@ -129,6 +156,54 @@ BEGIN { ok(isweak($foo->{foo_weak}), '... it is a weak reference'); + can_ok( $foo, 'foo_deref'); + is( $foo->foo_deref(), undef, '... unset value'); + my @list; + lives_ok { + @list = $foo->foo_deref(); + } "... doesn't deref undef value"; + is_deeply( \@list, [], "returns empty list in list context"); + + lives_ok { + $foo->foo_deref( [ qw/foo bar gorch/ ] ); + } '... foo_deref wrote successfully'; + + is( Scalar::Util::reftype( scalar $foo->foo_deref() ), "ARRAY", "returns an array reference in scalar context" ); + is_deeply( scalar($foo->foo_deref()), [ qw/foo bar gorch/ ], "correct array" ); + + is( scalar( () = $foo->foo_deref() ), 3, "returns list in list context" ); + is_deeply( [ $foo->foo_deref() ], [ qw/foo bar gorch/ ], "correct list" ); + + + can_ok( $foo, 'foo_deref' ); + is( $foo->foo_deref_ro(), undef, "... unset value" ); + + dies_ok { + $foo->foo_deref_ro( [] ); + } "... read only"; + + $foo->{foo_deref_ro} = [qw/la la la/]; + + is_deeply( scalar($foo->foo_deref_ro()), [qw/la la la/], "scalar context ro" ); + is_deeply( [ $foo->foo_deref_ro() ], [qw/la la la/], "list context ro" ); + + can_ok( $foo, 'foo_deref_hash' ); + is( $foo->foo_deref_hash(), undef, "... unset value" ); + + my %hash; + lives_ok { + %hash = $foo->foo_deref_hash(); + } "... doesn't deref undef value"; + is_deeply( \%hash, {}, "returns empty list in list context"); + + lives_ok { + $foo->foo_deref_hash( { foo => 1, bar => 2 } ); + } '... foo_deref_hash wrote successfully'; + + is_deeply( scalar($foo->foo_deref_hash), { foo => 1, bar => 2 }, "scalar context" ); + + %hash = $foo->foo_deref_hash; + is_deeply( \%hash, { foo => 1, bar => 2 }, "list context"); }