t/attributes/illegal_options_for_inheritance.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5 use Test::More;
   6 use Test::Fatal;
   7
   8 {
   9     package Foo;
  10     use Moose;
  11
  12     has foo => (
  13         is => 'ro',
  14     );
  15
  16     has bar => (
  17         clearer => 'clear_bar',
  18     );
  19 }
  20
  21 {
  22     package Foo::Sub;
  23     use Moose;
  24
  25     extends 'Foo';
  26
  27     ::is( ::exception { has '+foo' => (is => 'rw') }, undef, "can override is" );
  28     ::like( ::exception { has '+foo' => (reader => 'bar') }, qr/illegal/, "can't override reader" );
  29     ::is( ::exception { has '+foo' => (clearer => 'baz') }, undef, "can override unspecified things" );
  30
  31     ::like( ::exception { has '+bar' => (clearer => 'quux') }, qr/illegal/, "can't override clearer" );
  32     ::is( ::exception { has '+bar' => (predicate => 'has_bar') }, undef, "can override unspecified things" );
  33 }
  34
  35 {
  36     package Bar::Meta::Attribute;
  37     use Moose::Role;
  38
  39     has my_illegal_option => (is => 'ro');
  40
  41     around illegal_options_for_inheritance => sub {
  42         return (shift->(@_), 'my_illegal_option');
  43     };
  44 }
  45
  46 {
  47     package Bar;
  48     use Moose;
  49
  50     ::is( ::exception {
  51         has bar => (
  52             traits            => ['Bar::Meta::Attribute'],
  53             my_illegal_option => 'FOO',
  54             is                => 'bare',
  55         );
  56     }, undef, "can use illegal options" );
  57
  58     has baz => (
  59         traits => ['Bar::Meta::Attribute'],
  60         is     => 'bare',
  61     );
  62 }
  63
  64 {
  65     package Bar::Sub;
  66     use Moose;
  67
  68     extends 'Bar';
  69
  70     ::like( ::exception { has '+bar' => (my_illegal_option => 'BAR') }, qr/illegal/, "can't override illegal attribute" );
  71     ::is( ::exception { has '+baz' => (my_illegal_option => 'BAR') }, undef, "can add illegal option if superclass doesn't set it" );
  72 }
  73
  74 my $bar_attr = Bar->meta->get_attribute('bar');
  75 ok((grep { $_ eq 'my_illegal_option' } $bar_attr->illegal_options_for_inheritance) > 0, '... added my_illegal_option as illegal option for inheritance');
  76
  77 done_testing;