t/030_roles/017_extending_role_attrs.t

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