fixes

diff --git a/Changes b/Changes
index 9f02222..67be4f0 100644 (file)
--- a/Changes
+++ b/Changes
@@ -4,6 +4,10 @@ Revision history for Perl extension Moose
     * Moose
       - keywords are now exported with Sub::Exporter
         thanks to chansen for this commit
+      - has keyword now takes a 'metaclass' option 
+        to support custom attribute meta-classes 
+        on a per-attribute basis
+        - added tests for this
         
     * Moose::Role
       - keywords are now exported with Sub::Exporter

diff --git a/lib/Moose.pm b/lib/Moose.pm
index 483a487..ac35d37 100644 (file)
--- a/lib/Moose.pm
+++ b/lib/Moose.pm
@@ -42,16 +42,14 @@ use Moose::Util::TypeConstraints;
             $meta = $class->meta();
             (blessed($meta) && $meta->isa('Moose::Meta::Class'))
                 || confess "Whoops, not møøsey enough";
+            ($meta->attribute_metaclass->isa('Moose::Meta::Attribute'))
+                || confess "Attribute metaclass must be a subclass of Moose::Meta::Attribute";
         }
         else {
-            $meta = Moose::Meta::Class->initialize($class => (
-                ':attribute_metaclass' => 'Moose::Meta::Attribute'
-            ));
+            $meta = Moose::Meta::Class->initialize($class);
             $meta->add_method('meta' => sub {
                 # re-initialize so it inherits properly
-                Moose::Meta::Class->initialize($class => (
-                    ':attribute_metaclass' => 'Moose::Meta::Attribute'
-                ));
+                Moose::Meta::Class->initialize($class);
             })
         }
 
@@ -83,6 +81,9 @@ use Moose::Util::TypeConstraints;
             return subname 'Moose::has' => sub {
                 my ($name, %options) = @_;
                 if ($options{metaclass}) {
+                    _load_all_classes($options{metaclass});
+                    ($options{metaclass}->isa('Moose::Meta::Attribute'))
+                        || confess "Custom attribute metaclass must be a subclass of Moose::Meta::Attribute";
                     $meta->add_attribute($options{metaclass}->new($name, %options));
                 }
                 else {

diff --git a/lib/Moose/Meta/Class.pm b/lib/Moose/Meta/Class.pm
index e41d199..1c3ee1c 100644 (file)
--- a/lib/Moose/Meta/Class.pm
+++ b/lib/Moose/Meta/Class.pm
@@ -18,6 +18,14 @@ __PACKAGE__->meta->add_attribute('roles' => (
     default => sub { [] }
 ));
 
+sub initialize {
+    my $class = shift;
+    my $pkg   = shift;
+    $class->SUPER::initialize($pkg,
+        ':attribute_metaclass' => 'Moose::Meta::Attribute', 
+        @_);
+}
+
 sub add_role {
     my ($self, $role) = @_;
     (blessed($role) && $role->isa('Moose::Meta::Role'))
@@ -184,6 +192,8 @@ to the L<Class::MOP::Class> documentation.
 
 =over 4
 
+=item B<initialize>
+
 =item B<new_object>
 
 We override this method to support the C<trigger> attribute option.

diff --git a/t/036_custom_attribute_metaclass.t b/t/036_custom_attribute_metaclass.t
index aad1e00..eab082f 100644 (file)
--- a/t/036_custom_attribute_metaclass.t
+++ b/t/036_custom_attribute_metaclass.t
@@ -3,14 +3,14 @@
 use strict;
 use warnings;
 
-use Test::More tests => 10;
+use Test::More tests => 11;
 use Test::Exception;
 
 BEGIN {
     use_ok('Moose');           
 }
 
-{
+{    
     package Foo::Meta::Attribute;
     use strict;
     use warnings;
@@ -47,3 +47,21 @@ 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');
+
+{
+    package Bar::Meta::Attribute;
+    use strict;
+    use warnings;
+    
+    use base 'Class::MOP::Attribute';   
+    
+    package Bar;
+    use strict;
+    use warnings;
+    use Moose;
+    
+    ::dies_ok {
+        has 'bar' => (metaclass => 'Bar::Meta::Attribute');     
+    } '... the attribute metaclass must be a subclass of Moose::Meta::Attribute';
+}
+