t-failing/030_roles/017_extending_role_attrs.t

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