t/030_roles/017_extending_role_attrs.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More;
   7 use Test::Fatal;
   8
   9
  10 =pod
  11
  12 This basically just makes sure that using +name
  13 on role attributes works right.
  14
  15 =cut
  16
  17 {
  18     package Foo::Role;
  19     use Moose::Role;
  20
  21     has 'bar' => (
  22         is      => 'rw',
  23         isa     => 'Int',
  24         default => sub { 10 },
  25     );
  26
  27     package Foo;
  28     use Moose;
  29
  30     with 'Foo::Role';
  31
  32     ::is( ::exception {
  33         has '+bar' => (default => sub { 100 });
  34     }, undef, '... extended the attribute successfully' );
  35 }
  36
  37 my $foo = Foo->new;
  38 isa_ok($foo, 'Foo');
  39
  40 is($foo->bar, 100, '... got the extended attribute');
  41
  42
  43 {
  44     package Bar::Role;
  45     use Moose::Role;
  46
  47     has 'foo' => (
  48         is      => 'rw',
  49         isa     => 'Str | Int',
  50     );
  51
  52     package Bar;
  53     use Moose;
  54
  55     with 'Bar::Role';
  56
  57     ::is( ::exception {
  58         has '+foo' => (
  59             isa => 'Int',
  60         )
  61     }, undef, "... narrowed the role's type constraint successfully" );
  62 }
  63
  64 my $bar = Bar->new(foo => 42);
  65 isa_ok($bar, 'Bar');
  66 is($bar->foo, 42, '... got the extended attribute');
  67 $bar->foo(100);
  68 is($bar->foo, 100, "... can change the attribute's value to an Int");
  69
  70 like( exception { $bar->foo("baz") }, qr/^Attribute \(foo\) does not pass the type constraint because: Validation failed for 'Int' with value baz at / );
  71 is($bar->foo, 100, "... still has the old Int value");
  72
  73
  74 {
  75     package Baz::Role;
  76     use Moose::Role;
  77
  78     has 'baz' => (
  79         is      => 'rw',
  80         isa     => 'Value',
  81     );
  82
  83     package Baz;
  84     use Moose;
  85
  86     with 'Baz::Role';
  87
  88     ::is( ::exception {
  89         has '+baz' => (
  90             isa => 'Int | ClassName',
  91         )
  92     }, undef, "... narrowed the role's type constraint successfully" );
  93 }
  94
  95 my $baz = Baz->new(baz => 99);
  96 isa_ok($baz, 'Baz');
  97 is($baz->baz, 99, '... got the extended attribute');
  98 $baz->baz('Foo');
  99 is($baz->baz, 'Foo', "... can change the attribute's value to a ClassName");
 100
 101 like( exception { $baz->baz("zonk") }, qr/^Attribute \(baz\) does not pass the type constraint because: Validation failed for 'ClassName\|Int' with value zonk at / );
 102 is_deeply($baz->baz, 'Foo', "... still has the old ClassName value");
 103
 104
 105 {
 106     package Quux::Role;
 107     use Moose::Role;
 108
 109     has 'quux' => (
 110         is      => 'rw',
 111         isa     => 'Str | Int | Ref',
 112     );
 113
 114     package Quux;
 115     use Moose;
 116     use Moose::Util::TypeConstraints;
 117
 118     with 'Quux::Role';
 119
 120     subtype 'Positive'
 121         => as 'Int'
 122         => where { $_ > 0 };
 123
 124     ::is( ::exception {
 125         has '+quux' => (
 126             isa => 'Positive | ArrayRef',
 127         )
 128     }, undef, "... narrowed the role's type constraint successfully" );
 129 }
 130
 131 my $quux = Quux->new(quux => 99);
 132 isa_ok($quux, 'Quux');
 133 is($quux->quux, 99, '... got the extended attribute');
 134 $quux->quux(100);
 135 is($quux->quux, 100, "... can change the attribute's value to an Int");
 136 $quux->quux(["hi"]);
 137 is_deeply($quux->quux, ["hi"], "... can change the attribute's value to an ArrayRef");
 138
 139 like( exception { $quux->quux("quux") }, qr/^Attribute \(quux\) does not pass the type constraint because: Validation failed for 'ArrayRef\|Positive' with value quux at / );
 140 is_deeply($quux->quux, ["hi"], "... still has the old ArrayRef value");
 141
 142 like( exception { $quux->quux({a => 1}) }, qr/^Attribute \(quux\) does not pass the type constraint because: Validation failed for 'ArrayRef\|Positive' with value HASH\(\w+\) at / );
 143 is_deeply($quux->quux, ["hi"], "... still has the old ArrayRef value");
 144
 145
 146 {
 147     package Err::Role;
 148     use Moose::Role;
 149
 150     for (1..3) {
 151         has "err$_" => (
 152             isa => 'Str | Int',
 153             is => 'bare',
 154         );
 155     }
 156
 157     package Err;
 158     use Moose;
 159
 160     with 'Err::Role';
 161
 162     ::is( ::exception {
 163         has '+err1' => (isa => 'Defined');
 164     }, undef, "can get less specific in the subclass" );
 165
 166     ::is( ::exception {
 167         has '+err2' => (isa => 'Bool');
 168     }, undef, "or change the type completely" );
 169
 170     ::is( ::exception {
 171         has '+err3' => (isa => 'Str | ArrayRef');
 172     }, undef, "or add new types to the union" );
 173 }
 174
 175 {
 176     package Role::With::PlusAttr;
 177     use Moose::Role;
 178
 179     with 'Foo::Role';
 180
 181     ::like( ::exception {
 182         has '+bar' => ( is => 'ro' );
 183     }, qr/has '\+attr' is not supported in roles/, "Test has '+attr' in roles explodes" );
 184 }
 185
 186 done_testing;