X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2F020_attribute.t;h=f23a4346e41448ee13ce434e9f830b6abb0df062;hb=5efa6a46982d17e1ff642e8b97673c6618fa7e6d;hp=57b191719dc902cbd31bd8a61c94979feb8f7568;hpb=2eb717d56ee2a062202c58c415f4e56bcb90b40a;p=gitmo%2FClass-MOP.git

diff --git a/t/020_attribute.t b/t/020_attribute.t
index 57b1917..f23a434 100644
--- a/t/020_attribute.t
+++ b/t/020_attribute.t
@@ -1,26 +1,76 @@
-#!/usr/bin/perl
-
 use strict;
 use warnings;
 
-use Test::More no_plan => 1;
-use Test::Exception;
+use Scalar::Util 'reftype', 'blessed';
+
+use Test::More;
+use Test::Fatal;
+
+use Class::MOP;
+use Class::MOP::Attribute;
+use Class::MOP::Method;
+
+
+isnt( exception { Class::MOP::Attribute->name }, undef, q{... can't call name() as a class method} );
 
-BEGIN {
-    use_ok('Class::MOP::Attribute');
-}
 
 {
     my $attr = Class::MOP::Attribute->new('$foo');
     isa_ok($attr, 'Class::MOP::Attribute');
 
     is($attr->name, '$foo', '... $attr->name == $foo');
-    
+    ok($attr->has_init_arg, '... $attr does have an init_arg');
+    is($attr->init_arg, '$foo', '... $attr init_arg is the name');
+
     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->has_init_arg, '... $attr does not have an init_arg');
-    ok(!$attr->has_default, '... $attr does not have an default');                
+    ok(!$attr->has_default, '... $attr does not have an default');
+    ok(!$attr->has_builder, '... $attr does not have a builder');
+
+    {
+        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 $class = Class::MOP::Class->initialize('Foo');
+    isa_ok($class, 'Class::MOP::Class');
+
+    is( exception {
+        $attr->attach_to_class($class);
+    }, undef, '... 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');
+
+        isa_ok($reader, 'Class::MOP::Method');
+        isa_ok($writer, 'Class::MOP::Method');
+    }
+
+    my $attr_clone = $attr->clone();
+    isa_ok($attr_clone, 'Class::MOP::Attribute');
+    isnt($attr, $attr_clone, '... but they are different instances');
+
+    is($attr->associated_class, $attr_clone->associated_class, '... the associated classes are the same though');
+    is($attr->associated_class, $class, '... the associated classes are the same though');
+    is($attr_clone->associated_class, $class, '... the associated classes are the same though');
+
+    is_deeply($attr, $attr_clone, '... but they are the same inside');
 }
 
 {
@@ -31,15 +81,40 @@ BEGIN {
     isa_ok($attr, 'Class::MOP::Attribute');
 
     is($attr->name, '$foo', '... $attr->name == $foo');
-    
+
     ok($attr->has_init_arg, '... $attr does have an init_arg');
     is($attr->init_arg, '-foo', '... $attr->init_arg == -foo');
-    ok($attr->has_default, '... $attr does have an default');    
+    ok($attr->has_default, '... $attr does have an default');
     is($attr->default, 'BAR', '... $attr->default == BAR');
-    
+    ok(!$attr->has_builder, '... $attr does not have a builder');
+
     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->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');
+    isnt($attr, $attr_clone, '... but they are different instances');
+
+    is($attr->associated_class, $attr_clone->associated_class, '... the associated classes are the same though');
+    is($attr->associated_class, undef, '... the associated class is actually undef');
+    is($attr_clone->associated_class, undef, '... the associated class is actually undef');
+
+    is_deeply($attr, $attr_clone, '... but they are the same inside');
 }
 
 {
@@ -51,83 +126,123 @@ BEGIN {
     isa_ok($attr, 'Class::MOP::Attribute');
 
     is($attr->name, '$foo', '... $attr->name == $foo');
-    
+
     ok($attr->has_init_arg, '... $attr does have an init_arg');
     is($attr->init_arg, '-foo', '... $attr->init_arg == -foo');
-    ok($attr->has_default, '... $attr does have an default');    
+    ok($attr->has_default, '... $attr does have an default');
     is($attr->default, 'BAR', '... $attr->default == BAR');
 
-    ok($attr->has_accessor, '... $attr does have an accessor');    
+    ok($attr->has_accessor, '... $attr does have an accessor');
     is($attr->accessor, 'foo', '... $attr->accessor == foo');
-    
+
     ok(!$attr->has_reader, '... $attr does not have an reader');
-    ok(!$attr->has_writer, '... $attr does not have an writer');               
+    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');
+    isnt($attr, $attr_clone, '... but they are different instances');
+
+    is_deeply($attr, $attr_clone, '... but they are the same inside');
 }
 
 {
     my $attr = Class::MOP::Attribute->new('$foo', (
         reader   => 'get_foo',
-        writer   => 'set_foo',        
+        writer   => 'set_foo',
         init_arg => '-foo',
         default  => 'BAR'
     ));
     isa_ok($attr, 'Class::MOP::Attribute');
 
     is($attr->name, '$foo', '... $attr->name == $foo');
-    
+
     ok($attr->has_init_arg, '... $attr does have an init_arg');
     is($attr->init_arg, '-foo', '... $attr->init_arg == -foo');
-    ok($attr->has_default, '... $attr does have an default');    
+    ok($attr->has_default, '... $attr does have an default');
     is($attr->default, 'BAR', '... $attr->default == BAR');
 
     ok($attr->has_reader, '... $attr does have an reader');
-    is($attr->reader, 'get_foo', '... $attr->reader == get_foo');    
+    is($attr->reader, 'get_foo', '... $attr->reader == get_foo');
     ok($attr->has_writer, '... $attr does have an writer');
-    is($attr->writer, 'set_foo', '... $attr->writer == set_foo');    
+    is($attr->writer, 'set_foo', '... $attr->writer == set_foo');
 
-    ok(!$attr->has_accessor, '... $attr does not have an accessor');    
+    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');
+    isnt($attr, $attr_clone, '... but they are different instances');
+
+    is_deeply($attr, $attr_clone, '... but they are the same inside');
 }
 
-dies_ok {
-    my $attr = Class::MOP::Attribute->new('$foo', (
-        accessor => 'foo',
-        reader   => 'get_foo',
-    ));
-} '... cannot create accessors with reader/writers';
+{
+    my $attr = Class::MOP::Attribute->new('$foo');
+    isa_ok($attr, 'Class::MOP::Attribute');
 
-dies_ok {
-    my $attr = Class::MOP::Attribute->new('$foo', (
-        accessor => 'foo',
-        writer   => 'set_foo',
-    ));
-} '... cannot create accessors with reader/writers';
+    my $attr_clone = $attr->clone('name' => '$bar');
+    isa_ok($attr_clone, 'Class::MOP::Attribute');
+    isnt($attr, $attr_clone, '... but they are different instances');
 
-dies_ok {
-    my $attr = Class::MOP::Attribute->new('$foo', (
-        accessor => 'foo',
-        reader   => 'get_foo',        
-        writer   => 'set_foo',
-    ));
-} '... cannot create accessors with reader/writers';
+    isnt($attr->name, $attr_clone->name, '... we changes the name parameter');
+
+    is($attr->name, '$foo', '... $attr->name == $foo');
+    is($attr_clone->name, '$bar', '... $attr_clone->name == $bar');
+}
 
+{
+    my $attr = Class::MOP::Attribute->new('$foo', (builder => 'foo_builder'));
+    isa_ok($attr, 'Class::MOP::Attribute');
+
+    ok(!$attr->has_default, '... $attr does not have a default');
+    ok($attr->has_builder, '... $attr does have a builder');
+    is($attr->builder, 'foo_builder', '... $attr->builder == foo_builder');
+
+}
 
 {
-    my $meta = Class::MOP::Attribute->meta();
-    isa_ok($meta, 'Class::MOP::Class');
-    
-    foreach my $method_name (qw(
-        meta 
-        new
-        has_accessor accessor
-        has_writer   writer
-        has_reader   reader
-        has_init_arg init_arg
-        has_default  default
-        install_accessors
-        remove_accessors
-        )) {
-        ok($meta->has_method($method_name), '... Class::MOP::Attribute->has_method(' . $method_name . ')');
+    for my $value ({}, bless({}, 'Foo')) {
+        like( exception {
+            Class::MOP::Attribute->new('$foo', default => $value);
+        }, qr/References are not allowed as default values/ );
     }
-    
-    
 }
+
+{
+    my $attr;
+    is( exception {
+        my $meth = Class::MOP::Method->wrap(sub {shift}, name => 'foo', package_name => 'bar');
+        $attr = Class::MOP::Attribute->new('$foo', default => $meth);
+    }, undef, 'Class::MOP::Methods accepted as default' );
+
+    is($attr->default(42), 42, 'passthrough for default on attribute');
+}
+
+done_testing;