fixed

diff --git a/Changes b/Changes
index c93df81..30139e7 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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');