From: Guillermo Roditi Date: Wed, 29 Oct 2008 00:59:32 +0000 (+0000) Subject: 0.00400 X-Git-Tag: 0.00400^0 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=30cbeb5e3fce1f04a782071018f40e7e75d4b094;p=gitmo%2FMooseX-Emulate-Class-Accessor-Fast.git 0.00400 --- diff --git a/Changes b/Changes index 8cdcbed..a3b2425 100644 --- a/Changes +++ b/Changes @@ -1,3 +1,8 @@ +0.00400 Oct 28, 2008 + - Fix bug where a bad assumption was causing us to infinitely loop + on badly-written code like Data::Page. (Reported by marcus) + - Tests for this + - Up Moose dep to 0.31 0.00300 Jul XX, 2008 - Replace around 'new' with a BUILD method. Faster and avoids Moose bug with around/immutable and sub-classes. diff --git a/MANIFEST b/MANIFEST index 7018704..b0a5e85 100644 --- a/MANIFEST +++ b/MANIFEST @@ -15,5 +15,6 @@ META.yml README t/accessors.t t/adopt.t +t/construction.t t/getset.t t/lib/TestAdoptCAF.pm diff --git a/Makefile.PL b/Makefile.PL index c37a1f3..9dfb58a 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -9,8 +9,7 @@ abstract 'Emnulate Class::Accessor::Fast using attributes'; all_from 'lib/MooseX/Emulate/Class/Accessor/Fast.pm'; # Specific dependencies -requires 'Moose'; - +requires 'Moose' => '0.31'; build_requires 'Test::More' => 0; WriteAll; diff --git a/lib/MooseX/Emulate/Class/Accessor/Fast.pm b/lib/MooseX/Emulate/Class/Accessor/Fast.pm index 503f54f..27e19ca 100644 --- a/lib/MooseX/Emulate/Class/Accessor/Fast.pm +++ b/lib/MooseX/Emulate/Class/Accessor/Fast.pm @@ -2,7 +2,7 @@ package MooseX::Emulate::Class::Accessor::Fast; use Moose::Role; -our $VERSION = '0.00300'; +our $VERSION = '0.00400'; =head1 NAME @@ -97,17 +97,23 @@ sub mk_accessors{ for my $attr_name (@_){ my $reader = $self->accessor_name_for($attr_name); my $writer = $self->mutator_name_for( $attr_name); + #dont overwrite existing methods - my @opts = $reader eq $writer ? - ( $self->can($reader) ? () : (accessor => $reader) ) : - ( - ( $self->can($reader) ? () : (reader => $reader) ), - ( $self->can($writer) ? () : (writer => $writer) ), - ); - $meta->add_attribute($attr_name, @opts); - - $meta->add_method("_${attr_name}_accessor", $self->can($reader) ) - if($reader eq $attr_name && !$self->can("_${attr_name}_accessor") ); + if($reader eq $writer){ + my %opts = ( $self->can($reader) ? () : (accessor => $reader) ); + my $attr = $meta->add_attribute($attr_name, %opts); + if($attr_name eq $reader){ + my $alias = "_${attr_name}_accessor"; + next if $self->can($alias); + my @alias_method = $opts{accessor} ? ( $alias => $self->can($reader) ) + : ( $attr->process_accessors(accessor => $alias, 0 ) ); + $meta->add_method(@alias_method); + } + } else { + my @opts = ( $self->can($writer) ? () : (writer => $writer) ); + push(@opts, (reader => $reader)) unless $self->can($reader); + $meta->add_attribute($attr_name, @opts); + } } } @@ -122,10 +128,12 @@ sub mk_ro_accessors{ my $meta = $self->meta; for my $attr_name (@_){ my $reader = $self->accessor_name_for($attr_name); - $meta->add_attribute($attr_name, - $self->can($reader) ? () : (reader => $reader) ); - $meta->add_method("_${attr_name}_accessor", $meta->find_method_by_name($reader)) - if($reader eq $attr_name && !$self->can("_${attr_name}_accessor") ); + my @opts = ($self->can($reader) ? () : (reader => $reader) ); + my $attr = $meta->add_attribute($attr_name, @opts); + if($reader eq $attr_name && $reader eq $self->mutator_name_for($attr_name)){ + $meta->add_method("_${attr_name}_accessor" => $attr->get_read_method_ref) + unless $self->can("_${attr_name}_accessor"); + } } } @@ -141,9 +149,12 @@ sub mk_wo_accessors{ my $meta = $self->meta; for my $attr_name (@_){ my $writer = $self->mutator_name_for($attr_name); - $meta->add_attribute($attr_name, $self->can($writer) ? () : (writer => $writer) ); - $meta->add_method("_${attr_name}_accessor", $meta->find_method_by_name($writer)) - if($writer eq $attr_name && !$self->can("_${attr_name}_accessor") ); + my @opts = ($self->can($writer) ? () : (writer => $writer) ); + my $attr = $meta->add_attribute($attr_name, @opts); + if($writer eq $attr_name && $writer eq $self->accessor_name_for($attr_name)){ + $meta->add_method("_${attr_name}_accessor" => $attr->get_write_method_ref) + unless $self->can("_${attr_name}_accessor"); + } } } diff --git a/t/accessors.t b/t/accessors.t index 5341d75..04efe4b 100644 --- a/t/accessors.t +++ b/t/accessors.t @@ -1,6 +1,9 @@ #!perl use strict; -use Test::More tests => 32; +use Test::More tests => 33; +use Test::Exception; + +use Class::MOP; #1 require_ok("MooseX::Adopt::Class::Accessor::Fast"); @@ -8,12 +11,21 @@ require_ok("MooseX::Adopt::Class::Accessor::Fast"); my $class = "Testing::Class::Accessor::Fast"; { - no strict 'refs'; - @{"${class}::ISA"} = ('Class::Accessor::Fast'); - *{"${class}::car"} = sub { shift->_car_accessor(@_); }; - *{"${class}::mar"} = sub { return "Overloaded"; }; + my $infinite_loop_indicator = 0; + my $meta = Class::MOP::Class->create( + $class, + superclasses => ['Class::Accessor::Fast'], + methods => { + car => sub { shift->_car_accessor(@_); }, + mar => sub { return "Overloaded"; }, + test => sub { + die('Infinite loop detected') if $infinite_loop_indicator++; + $_[0]->_test_accessor((@_ > 1 ? @_ : ())); + } + } + ); - $class->mk_accessors(qw( foo bar yar car mar )); + $class->mk_accessors(qw( foo bar yar car mar test)); $class->mk_ro_accessors(qw(static unchanged)); $class->mk_wo_accessors(qw(sekret double_sekret)); $class->follow_best_practice; @@ -23,14 +35,14 @@ my $class = "Testing::Class::Accessor::Fast"; my %attrs = map{$_->name => $_} $class->meta->compute_all_applicable_attributes; #2 -is(keys %attrs, 10, 'Correct number of attributes'); +is(keys %attrs, 11, 'Correct number of attributes'); #3-12 ok(exists $attrs{$_}, "Attribute ${_} created") for qw( foo bar yar car mar static unchanged sekret double_sekret best ); #13-21 -ok($class->can("_${_}_accessor"), "Attribute ${_} created") +ok($class->can("_${_}_accessor"), "Alias method (_${_}_accessor) for ${_} created") for qw( foo bar yar car mar static unchanged sekret double_sekret ); #22-24 @@ -52,3 +64,6 @@ is( $attrs{$_}->writer, $_, "Writer ${_} created") #31,32 is( $attrs{'best'}->reader, 'get_best', "Reader get_best created"); is( $attrs{'best'}->writer, 'set_best', "Writer set_best created"); + +#33 +lives_ok{ $class->new->test(1) } 'no auto-reference to accessors from aliases';