From: Tomas Doran <bobtfish@bobtfish.net>
Date: Sun, 20 Apr 2008 09:07:35 +0000 (+0000)
Subject: Allow overriding of metaclass and traits in has '+$foo' + tests as discussed on the... 
X-Git-Tag: 0_55~215
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=39d37838ef6f87c92004ae4d9e6a87cdba26e2b6;p=gitmo%2FMoose.git

Allow overriding of metaclass and traits in has '+$foo' + tests as discussed on the list. Tests don't all pass - is this a bug, or am I doing it wrong? (Docs to follow when the tests pass)
---

diff --git a/lib/Moose/Meta/Attribute.pm b/lib/Moose/Meta/Attribute.pm
index 01cc66f..0c9d98a 100644
--- a/lib/Moose/Meta/Attribute.pm
+++ b/lib/Moose/Meta/Attribute.pm
@@ -67,9 +67,9 @@ sub new {
 
 sub clone_and_inherit_options {
     my ($self, %options) = @_;
-    # you can change default, required, coerce, documentation and lazy
+    # you can change default, required, coerce, documentation, lazy, handles, builder, metaclass and traits
     my %actual_options;
-    foreach my $legal_option (qw(default coerce required documentation lazy handles builder)) {
+    foreach my $legal_option (qw(default coerce required documentation lazy handles builder metaclass traits)) {
         if (exists $options{$legal_option}) {
             $actual_options{$legal_option} = $options{$legal_option};
             delete $options{$legal_option};
diff --git a/t/020_attributes/009_attribute_inherited_slot_specs.t b/t/020_attributes/009_attribute_inherited_slot_specs.t
index 4efb792..0f1c33c 100644
--- a/t/020_attributes/009_attribute_inherited_slot_specs.t
+++ b/t/020_attributes/009_attribute_inherited_slot_specs.t
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 83;
+use Test::More tests => 85;
 use Test::Exception;
 
 BEGIN {
@@ -84,7 +84,15 @@ BEGIN {
     ::lives_ok {
         has '+one_last_one' => (isa => 'Value');        
     } '... now can extend an attribute with a non-subtype';    
-    
+
+    ::lives_ok {
+        has '+foo' => ( metaclass => 'DoNotSerialize' ); 
+    } 'Can add metaclass attribute option';
+
+    ::lives_ok {
+        has '+foo' => ( traits => [ 'DoNotSerialize' ] );
+    } 'Can add traits attribute option';   
+ 
     ::lives_ok {
         has '+bling' => (handles => ['hello']);        
     } '... we can add the handles attribute option';
diff --git a/t/020_attributes/016_attribute_traits_registered.t b/t/020_attributes/016_attribute_traits_registered.t
index 2060f02..611d3d0 100644
--- a/t/020_attributes/016_attribute_traits_registered.t
+++ b/t/020_attributes/016_attribute_traits_registered.t
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 6;
+use Test::More tests => 13;
 use Test::Exception;
 use Test::Moose;
 
@@ -30,6 +30,26 @@ BEGIN {
 }
 
 {
+    package My::Other::Attribute::Trait;
+    use Moose::Role;
+    
+    my $method = sub {
+        42;
+    };   
+ 
+    after 'install_accessors' => sub {
+        my $self = shift;
+        $self->associated_class->add_method(
+            'additional_method', 
+            $method
+        );
+    };
+    
+    package Moose::Meta::Attribute::Custom::Trait::Other;
+    sub register_implementation { 'My::Other::Attribute::Trait' }
+}
+
+{
     package My::Class;
     use Moose;
     
@@ -41,12 +61,40 @@ BEGIN {
     );
 }
 
+{   
+    package My::Derived::Class;
+    use Moose;
+
+    extends 'My::Class';
+
+    has '+bar' => (
+        traits   => [qw/Other/],
+    );
+}
+
 my $c = My::Class->new(bar => 100);
 isa_ok($c, 'My::Class');
 
 is($c->bar, 100, '... got the right value for bar');
 
-can_ok($c, 'baz');
+can_ok($c, 'baz') and
 is($c->baz, 100, '... got the right value for baz');
 
 does_ok($c->meta->get_attribute('bar'), 'My::Attribute::Trait');
+
+my $quux = My::Derived::Class->new(bar => 1000);
+
+is($quux->bar, 1000, '... got the right value for bar');
+
+can_ok($quux, 'baz');
+is($quux->baz, 1000, '... got the right value for baz');
+ok($quux->meta->get_attribute('bar')->does('My::Attribute::Trait'));
+
+TODO: {
+    local $TODO = 'These do not pass - bug?';
+    SKIP: {
+        skip 'no additional_method, so cannot test its value', 1 if !can_ok($quux, 'additional_method');
+        is($quux->additional_method, 42, '... got the right value for additional_method');
+    }
+    ok($quux->meta->get_attribute('bar')->does('My::Other::Attribute::Trait'));
+}