clean up some things, and allow overriding unspecified options

diff --git a/lib/Moose/Meta/Attribute.pm b/lib/Moose/Meta/Attribute.pm
index 818efd1..936dc37 100644 (file)
--- a/lib/Moose/Meta/Attribute.pm
+++ b/lib/Moose/Meta/Attribute.pm
@@ -131,7 +131,10 @@ sub interpolate_class {
 
 # ...
 
-sub illegal_options_for_inheritance { }
+# method-generating options shouldn't be overridden
+sub illegal_options_for_inheritance {
+    qw(is reader writer accessor clearer predicate)
+}
 
 # NOTE/TODO
 # This method *must* be able to handle
@@ -150,8 +153,6 @@ sub illegal_options_for_inheritance { }
 sub clone_and_inherit_options {
     my ($self, %options) = @_;
 
-    my %copy = %options;
-
     # NOTE:
     # we may want to extends a Class::MOP::Attribute
     # in which case we need to be able to use the
@@ -163,7 +164,7 @@ sub clone_and_inherit_options {
         ? $self->illegal_options_for_inheritance
         : ();
 
-    my @found_illegal_options = grep { exists $options{$_} ? $_ : undef } @illegal_options;
+    my @found_illegal_options = grep { exists $options{$_} && exists $self->{$_} ? $_ : undef } @illegal_options;
     (scalar @found_illegal_options == 0)
         || $self->throw_error("Illegal inherited options => (" . (join ', ' => @found_illegal_options) . ")", data => \%options);
 

diff --git a/t/020_attributes/022_illegal_options_for_inheritance.t b/t/020_attributes/022_illegal_options_for_inheritance.t
index 49c16e9..7448813 100644 (file)
--- a/t/020_attributes/022_illegal_options_for_inheritance.t
+++ b/t/020_attributes/022_illegal_options_for_inheritance.t
@@ -3,39 +3,78 @@
 use strict;
 use warnings;
 use Test::More;
+use Test::Exception;
 
+{
+    package Foo;
+    use Moose;
+
+    has foo => (
+        is => 'ro',
+    );
 
+    has bar => (
+        clearer => 'clear_bar',
+    );
+}
 
 {
-    package Bar::Meta::Attribute;
+    package Foo::Sub;
     use Moose;
 
-    extends 'Moose::Meta::Attribute';
+    extends 'Foo';
 
-    has 'my_illegal_option' => (
-      isa => 'CodeRef',
-      is => 'rw',
-    );
+    ::throws_ok { has '+foo' => (is => 'rw') } qr/illegal/, "can't override is";
+    ::throws_ok { has '+foo' => (reader => 'bar') } qr/illegal/, "can't override reader";
+    ::lives_ok { has '+foo' => (clearer => 'baz') }  "can override unspecified things";
+
+    ::throws_ok { has '+bar' => (clearer => 'quux') }  qr/illegal/, "can't override clearer";
+    ::lives_ok { has '+bar' => (predicate => 'has_bar') }  "can override unspecified things";
+}
+
+{
+    package Bar::Meta::Attribute;
+    use Moose::Role;
+
+    has my_illegal_option => (is => 'ro');
 
     around illegal_options_for_inheritance => sub {
-      return (shift->(@_), qw/my_illegal_option/);
+        return (shift->(@_), 'my_illegal_option');
     };
+}
 
+{
     package Bar;
     use Moose;
 
-    has 'bar' => (
-      metaclass       => 'Bar::Meta::Attribute',
-      my_illegal_option => sub { 'Bar' },
-      is => 'bare',
+    ::lives_ok {
+        has bar => (
+            traits            => ['Bar::Meta::Attribute'],
+            my_illegal_option => 'FOO',
+            is                => 'bare',
+        );
+    } "can use illegal options";
+
+    has baz => (
+        traits => ['Bar::Meta::Attribute'],
+        is     => 'bare',
     );
 }
 
+{
+    package Bar::Sub;
+    use Moose;
+
+    extends 'Bar';
+
+    ::throws_ok { has '+bar' => (my_illegal_option => 'BAR') }
+                qr/illegal/,
+                "can't override illegal attribute";
+    ::lives_ok { has '+baz' => (my_illegal_option => 'BAR') }
+               "can add illegal option if superclass doesn't set it";
+}
+
 my $bar_attr = Bar->meta->get_attribute('bar');
-my ($illegal_option) = grep {
-  $_ eq 'my_illegal_option'
-} $bar_attr->illegal_options_for_inheritance;
-is($illegal_option, 'my_illegal_option',
-  '... added my_illegal_option as illegal option for inheritance' );
+ok((grep { $_ eq 'my_illegal_option' } $bar_attr->illegal_options_for_inheritance) > 0, '... added my_illegal_option as illegal option for inheritance');
 
 done_testing;