From: Guillermo Roditi Date: Sat, 22 Nov 2008 20:34:02 +0000 (+0000) Subject: tests + fix for $obj->$code_ref notation that blew up X-Git-Tag: 0.00500~2 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=gitmo%2FMooseX-Emulate-Class-Accessor-Fast.git;a=commitdiff_plain;h=e8abb6ef66e72c5943e570e94b31b8b6fc4bf321 tests + fix for $obj->$code_ref notation that blew up --- diff --git a/Changes b/Changes index 42201c7..f5ca808 100644 --- a/Changes +++ b/Changes @@ -1,5 +1,6 @@ 0.00500 - make_accessor, make_ro_accessor, make_rw_accessor + - tests 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) diff --git a/lib/MooseX/Emulate/Class/Accessor/Fast.pm b/lib/MooseX/Emulate/Class/Accessor/Fast.pm index f87ca44..377eaa0 100644 --- a/lib/MooseX/Emulate/Class/Accessor/Fast.pm +++ b/lib/MooseX/Emulate/Class/Accessor/Fast.pm @@ -234,8 +234,8 @@ sub make_accessor { my $writer = $attr->get_write_method_ref; return sub { my $self = shift; - return $self->$reader unless @_; - return $self->$writer((@_ > 1 ? [@_] : @_)); + return $reader->($self) unless @_; + return $writer->($self,(@_ > 1 ? [@_] : @_)); } } diff --git a/t/getset.t b/t/getset.t index d3ad761..b3b13b4 100644 --- a/t/getset.t +++ b/t/getset.t @@ -1,14 +1,30 @@ #!perl use strict; -use Test::More tests => 3; +use Test::More tests => 9; require_ok("MooseX::Adopt::Class::Accessor::Fast"); +{ + @Foo::ISA = qw(Class::Accessor::Fast); + Foo->mk_accessors(qw( foo )); + my $test = Foo->new({ foo => 49 }); + is( $test->get('foo'), 49, "get initial foo"); + $test->set('foo', 42); + is($test->get('foo'), 42, "get new foo"); +} -@Foo::ISA = qw(Class::Accessor::Fast); -Foo->mk_accessors(qw( foo )); +{ + @Bar::ISA = qw(Class::Accessor::Fast); + my $get_ref = Bar->make_ro_accessor('read'); + my $set_ref = Bar->make_wo_accessor('write'); + my $getset_ref = Bar->make_accessor('read_write'); -my $test = Foo->new({ foo => 49 }); + ok(Bar->meta->has_attribute("read"),"has read"); + ok(Bar->meta->has_attribute("write"),"has write"); + ok(Bar->meta->has_attribute("read_write"),"has read_write"); -is( $test->get('foo'), 49, "get initial foo"); -$test->set('foo', 42); -is($test->get('foo'), 42, "get new foo"); + my $obj = Bar->new({read => 1, write => 2, read_write => 3}); + is($get_ref->($obj), 1, "read get works"); + is($getset_ref->($obj), 3, "read_write get works"); + $getset_ref->($obj,2); + is($getset_ref->($obj), 2, "read_write set works"); +}