t/030_roles/failing/017_extending_role_attrs.t

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