custom attribute metaclasses

diff --git a/lib/Moose.pm b/lib/Moose.pm
index a3cc118..483a487 100644 (file)
--- a/lib/Moose.pm
+++ b/lib/Moose.pm
@@ -82,7 +82,12 @@ use Moose::Util::TypeConstraints;
             my $meta = _find_meta();
             return subname 'Moose::has' => sub {
                 my ($name, %options) = @_;
-                $meta->add_attribute($name, %options)
+                if ($options{metaclass}) {
+                    $meta->add_attribute($options{metaclass}->new($name, %options));
+                }
+                else {
+                    $meta->add_attribute($name, %options);
+                }
             };
         },
         before => sub {

diff --git a/t/036_custom_attribute_metaclass.t b/t/036_custom_attribute_metaclass.t
new file mode 100644 (file)
index 0000000..aad1e00
--- /dev/null
+++ b/t/036_custom_attribute_metaclass.t
@@ -0,0 +1,49 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 10;
+use Test::Exception;
+
+BEGIN {
+    use_ok('Moose');           
+}
+
+{
+    package Foo::Meta::Attribute;
+    use strict;
+    use warnings;
+    
+    use base 'Moose::Meta::Attribute';
+    
+    sub new {
+        my $class = shift;
+        $class->SUPER::new(@_, (is => 'rw', isa => 'Foo'));
+    }
+
+    package Foo;
+    use strict;
+    use warnings;
+    use Moose;
+    
+    has 'foo' => (metaclass => 'Foo::Meta::Attribute');
+}
+
+my $foo = Foo->new;
+isa_ok($foo, 'Foo');
+
+my $foo_attr = Foo->meta->get_attribute('foo');
+isa_ok($foo_attr, 'Foo::Meta::Attribute');
+isa_ok($foo_attr, 'Moose::Meta::Attribute');
+
+is($foo_attr->name, 'foo', '... got the right name for our meta-attribute');
+ok($foo_attr->has_accessor, '... our meta-attrubute created the accessor for us');
+
+ok($foo_attr->has_type_constraint, '... our meta-attrubute created the type_constraint for us');
+
+my $foo_attr_type_constraint = $foo_attr->type_constraint;
+isa_ok($foo_attr_type_constraint, 'Moose::Meta::TypeConstraint');
+
+is($foo_attr_type_constraint->name, 'Foo', '... got the right type constraint name');
+is($foo_attr_type_constraint->parent->name, 'Object', '... got the right type constraint parent name');