From: Stevan Little Date: Sat, 24 Nov 2007 15:28:12 +0000 (+0000) Subject: fixed X-Git-Tag: 0_49~12 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=742fb371653d58d3aca4dccadcb7dd4e7c736354;p=gitmo%2FClass-MOP.git fixed --- diff --git a/Changes b/Changes index c93df81..30139e7 100644 --- a/Changes +++ b/Changes @@ -1,5 +1,9 @@ Revision history for Perl extension Class-MOP. +0.47 Sat. Nov. 24, 2007 + * Class::MOP::Attribute + - fixed misspelling in get_write_method_ref + 0.46 Fri. Nov. 23, 2007 * Class::MOP::Class - added the linearized_isa method instead of constantly diff --git a/lib/Class/MOP.pm b/lib/Class/MOP.pm index 7d60774..474ae18 100644 --- a/lib/Class/MOP.pm +++ b/lib/Class/MOP.pm @@ -13,7 +13,7 @@ use Class::MOP::Method; use Class::MOP::Immutable; -our $VERSION = '0.46'; +our $VERSION = '0.47'; our $AUTHORITY = 'cpan:STEVAN'; { diff --git a/lib/Class/MOP/Attribute.pm b/lib/Class/MOP/Attribute.pm index 767ec1d..32931a9 100644 --- a/lib/Class/MOP/Attribute.pm +++ b/lib/Class/MOP/Attribute.pm @@ -9,7 +9,7 @@ use Class::MOP::Method::Accessor; use Carp 'confess'; use Scalar::Util 'blessed', 'reftype', 'weaken'; -our $VERSION = '0.18'; +our $VERSION = '0.19'; our $AUTHORITY = 'cpan:STEVAN'; use base 'Class::MOP::Object'; @@ -138,7 +138,7 @@ sub get_write_method { $_[0]->writer || $_[0]->accessor } sub get_read_method_ref { my $self = shift; - if (my $reader = $self->get_read_method) { + if ((my $reader = $self->get_read_method) && $self->associated_class) { return $self->associated_class->get_method($reader); } else { @@ -148,8 +148,8 @@ sub get_read_method_ref { sub get_write_method_ref { my $self = shift; - if (my $writer = $self->get_write_method) { - return $self->assocaited_class->get_method($writer); + if ((my $writer = $self->get_write_method) && $self->associated_class) { + return $self->associated_class->get_method($writer); } else { return sub { $self->set_value(@_) }; diff --git a/t/020_attribute.t b/t/020_attribute.t index 33cafdd..3ec9921 100644 --- a/t/020_attribute.t +++ b/t/020_attribute.t @@ -3,7 +3,9 @@ use strict; use warnings; -use Test::More tests => 73; +use Scalar::Util 'reftype', 'blessed'; + +use Test::More tests => 97; use Test::Exception; BEGIN { @@ -33,6 +35,20 @@ BEGIN { } '... attached a class successfully'; is($attr->associated_class, $class, '... the class was associated correctly'); + + ok(!$attr->get_read_method, '... $attr does not have an read method'); + ok(!$attr->get_write_method, '... $attr does not have an write method'); + + { + my $reader = $attr->get_read_method_ref; + my $writer = $attr->get_write_method_ref; + + ok(!blessed($reader), '... it is a plain old sub'); + ok(!blessed($writer), '... it is a plain old sub'); + + is(reftype($reader), 'CODE', '... it is a plain old sub'); + is(reftype($writer), 'CODE', '... it is a plain old sub'); + } my $attr_clone = $attr->clone(); isa_ok($attr_clone, 'Class::MOP::Attribute'); @@ -63,6 +79,20 @@ BEGIN { ok(!$attr->has_accessor, '... $attr does not have an accessor'); ok(!$attr->has_reader, '... $attr does not have an reader'); ok(!$attr->has_writer, '... $attr does not have an writer'); + + ok(!$attr->get_read_method, '... $attr does not have an read method'); + ok(!$attr->get_write_method, '... $attr does not have an write method'); + + { + my $reader = $attr->get_read_method_ref; + my $writer = $attr->get_write_method_ref; + + ok(!blessed($reader), '... it is a plain old sub'); + ok(!blessed($writer), '... it is a plain old sub'); + + is(reftype($reader), 'CODE', '... it is a plain old sub'); + is(reftype($writer), 'CODE', '... it is a plain old sub'); + } my $attr_clone = $attr->clone(); isa_ok($attr_clone, 'Class::MOP::Attribute'); @@ -95,6 +125,20 @@ BEGIN { ok(!$attr->has_reader, '... $attr does not have an reader'); ok(!$attr->has_writer, '... $attr does not have an writer'); + + is($attr->get_read_method, 'foo', '... $attr does not have an read method'); + is($attr->get_write_method, 'foo', '... $attr does not have an write method'); + + { + my $reader = $attr->get_read_method_ref; + my $writer = $attr->get_write_method_ref; + + ok(!blessed($reader), '... it is not a plain old sub'); + ok(!blessed($writer), '... it is not a plain old sub'); + + is(reftype($reader), 'CODE', '... it is a plain old sub'); + is(reftype($writer), 'CODE', '... it is a plain old sub'); + } my $attr_clone = $attr->clone(); isa_ok($attr_clone, 'Class::MOP::Attribute'); @@ -125,6 +169,20 @@ BEGIN { is($attr->writer, 'set_foo', '... $attr->writer == set_foo'); ok(!$attr->has_accessor, '... $attr does not have an accessor'); + + is($attr->get_read_method, 'get_foo', '... $attr does not have an read method'); + is($attr->get_write_method, 'set_foo', '... $attr does not have an write method'); + + { + my $reader = $attr->get_read_method_ref; + my $writer = $attr->get_write_method_ref; + + ok(!blessed($reader), '... it is not a plain old sub'); + ok(!blessed($writer), '... it is not a plain old sub'); + + is(reftype($reader), 'CODE', '... it is a plain old sub'); + is(reftype($writer), 'CODE', '... it is a plain old sub'); + } my $attr_clone = $attr->clone(); isa_ok($attr_clone, 'Class::MOP::Attribute'); diff --git a/t/022_attribute_duplication.t b/t/022_attribute_duplication.t index f23d4a1..3fa68b1 100644 --- a/t/022_attribute_duplication.t +++ b/t/022_attribute_duplication.t @@ -3,7 +3,9 @@ use strict; use warnings; -use Test::More tests => 17; +use Scalar::Util; + +use Test::More tests => 29; BEGIN { use_ok('Class::MOP'); @@ -36,6 +38,20 @@ one first. ::is($bar_attr->writer, 'set_bar', '... the bar attribute has the writer set_bar'); ::is($bar_attr->associated_class, Foo->meta, '... and the bar attribute is associated with Foo->meta'); + ::is($bar_attr->get_read_method, 'get_bar', '... $attr does have an read method'); + ::is($bar_attr->get_write_method, 'set_bar', '... $attr does have an write method'); + + { + my $reader = $bar_attr->get_read_method_ref; + my $writer = $bar_attr->get_write_method_ref; + + ::isa_ok($reader, 'Class::MOP::Method'); + ::isa_ok($writer, 'Class::MOP::Method'); + + ::is(Scalar::Util::reftype($reader->body), 'CODE', '... it is a plain old sub'); + ::is(Scalar::Util::reftype($writer->body), 'CODE', '... it is a plain old sub'); + } + Foo->meta->add_attribute('bar' => reader => 'assign_bar' ); @@ -47,6 +63,20 @@ one first. my $bar_attr2 = Foo->meta->get_attribute('bar'); + ::is($bar_attr2->get_read_method, 'assign_bar', '... $attr does have an read method'); + ::ok(!$bar_attr2->get_write_method, '... $attr does have an write method'); + + { + my $reader = $bar_attr2->get_read_method_ref; + my $writer = $bar_attr2->get_write_method_ref; + + ::isa_ok($reader, 'Class::MOP::Method'); + ::ok(!Scalar::Util::blessed($writer), '... the writer method is not blessed though'); + + ::is(Scalar::Util::reftype($reader->body), 'CODE', '... it is a plain old sub'); + ::is(Scalar::Util::reftype($writer), 'CODE', '... it is a plain old sub'); + } + ::isnt($bar_attr, $bar_attr2, '... this is a new bar attribute'); ::isnt($bar_attr->associated_class, Foo->meta, '... and the old bar attribute is no longer associated with Foo->meta');