From: gfx <gfuji@cpan.org>
Date: Mon, 26 Jul 2010 11:26:33 +0000 (+0900)
Subject: Fix illegal option process, add tests for it
X-Git-Tag: 0.64~4
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=4a07d07686d449924ad2ace3cffa03a79fe75951;p=gitmo%2FMouse.git

Fix illegal option process, add tests for it
---

diff --git a/lib/Mouse/Meta/Attribute.pm b/lib/Mouse/Meta/Attribute.pm
index 12dead6..aa92e70 100644
--- a/lib/Mouse/Meta/Attribute.pm
+++ b/lib/Mouse/Meta/Attribute.pm
@@ -201,7 +201,7 @@ sub clone_and_inherit_options{
     my $args = $self->Mouse::Object::BUILDARGS(@_);
 
     foreach my $illegal($self->illegal_options_for_inheritance) {
-        if(exists $args->{$illegal}) {
+        if(exists $args->{$illegal} and exists $self->{$illegal}) {
             $self->throw_error("Illegal inherited option: $illegal");
         }
     }
diff --git a/t/020_attributes/022_illegal_options_for_inheritance.t b/t/020_attributes/022_illegal_options_for_inheritance.t
new file mode 100644
index 0000000..014d946
--- /dev/null
+++ b/t/020_attributes/022_illegal_options_for_inheritance.t
@@ -0,0 +1,80 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+use Test::More;
+use Test::Exception;
+
+{
+    package Foo;
+    use Mouse;
+
+    has foo => (
+        is => 'ro',
+    );
+
+    has bar => (
+        clearer => 'clear_bar',
+    );
+}
+
+{
+    package Foo::Sub;
+    use Mouse;
+
+    extends 'Foo';
+
+    ::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 Mouse::Role;
+
+    has my_illegal_option => (is => 'ro');
+
+    around illegal_options_for_inheritance => sub {
+        return (shift->(@_), 'my_illegal_option');
+    };
+}
+
+{
+    package Bar;
+    use Mouse;
+
+    ::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 Mouse;
+
+    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');
+ok((grep { $_ eq 'my_illegal_option' } $bar_attr->illegal_options_for_inheritance) > 0, '... added my_illegal_option as illegal option for inheritance');
+
+done_testing;
diff --git a/t/020_attributes/failing/022_legal_options_for_inheritance.t b/t/020_attributes/failing/022_legal_options_for_inheritance.t
deleted file mode 100644
index 2830506..0000000
--- a/t/020_attributes/failing/022_legal_options_for_inheritance.t
+++ /dev/null
@@ -1,49 +0,0 @@
-#!/usr/bin/perl
-
-use strict;
-use warnings;
-use Test::More tests => 2;
-
-
-
-{
-    package Bar::Meta::Attribute;
-    use Mouse;
-
-    extends 'Mouse::Meta::Attribute';
-
-    has 'my_legal_option' => (
-      isa => 'CodeRef',
-      is => 'rw',
-    );
-
-    around legal_options_for_inheritance => sub {
-      return (shift->(@_), qw/my_legal_option/);
-    };
-
-    package Bar;
-    use Mouse;
-
-    has 'bar' => (
-      metaclass       => 'Bar::Meta::Attribute',
-      my_legal_option => sub { 'Bar' },
-      is => 'bare',
-    );
-
-    package Bar::B;
-    use Mouse;
-
-    extends 'Bar';
-
-    has '+bar' => (
-      my_legal_option => sub { 'Bar::B' }
-    );
-}
-
-my $bar_attr = Bar::B->meta->get_attribute('bar');
-my ($legal_option) = grep {
-  $_ eq 'my_legal_option'
-} $bar_attr->legal_options_for_inheritance;
-is($legal_option, 'my_legal_option',
-  '... added my_legal_option as legal option for inheritance' );
-is($bar_attr->my_legal_option->(), 'Bar::B', '... overloaded my_legal_option');