t/001_mouse/043-parameterized-type.t

   1 #!perl
   2 use strict;
   3 use warnings;
   4 use Test::More;
   5 use Test::Exception;
   6
   7 use Tie::Hash;
   8 use Tie::Array;
   9
  10 {
  11     {
  12         package My::Role;
  13         use Mouse::Role;
  14
  15         package My::Class;
  16         use Mouse;
  17
  18         with 'My::Role';
  19
  20         package Foo;
  21         use Mouse;
  22
  23         has foo => (
  24             is  => 'ro',
  25             isa => 'HashRef[Int]',
  26         );
  27
  28         has bar => (
  29             is  => 'ro',
  30             isa => 'ArrayRef[Int]',
  31         );
  32
  33         has complex => (
  34             is  => 'rw',
  35             isa => 'ArrayRef[HashRef[Int]]'
  36         );
  37
  38         has my_class => (
  39             is  => 'rw',
  40             isa => 'ArrayRef[My::Class]',
  41         );
  42
  43         has my_role => (
  44             is  => 'rw',
  45             isa => 'ArrayRef[My::Role]',
  46         );
  47     };
  48
  49     ok(Foo->meta->has_attribute('foo'));
  50
  51     lives_and {
  52         my $hash = { a => 1, b => 2, c => 3 };
  53         my $array = [ 1, 2, 3 ];
  54         my $complex = [ { a => 1, b => 1 }, { c => 2, d => 2} ];
  55         my $foo = Foo->new(foo => $hash, bar => $array, complex => $complex);
  56
  57         is_deeply($foo->foo(), $hash, "foo is a proper hash");
  58         is_deeply($foo->bar(), $array, "bar is a proper array");
  59         is_deeply($foo->complex(), $complex, "complex is a proper ... structure");
  60
  61         $foo->my_class([My::Class->new]);
  62         is ref($foo->my_class), 'ARRAY';
  63         isa_ok $foo->my_class->[0], 'My::Class';
  64
  65         $foo->my_role([My::Class->new]);
  66         is ref($foo->my_role), 'ARRAY';
  67
  68     } "Parameterized constraints work";
  69
  70     # check bad args
  71     throws_ok {
  72         Foo->new( foo => { a => 'b' });
  73     } qr/Attribute \(foo\) does not pass the type constraint because: Validation failed for 'HashRef\[Int\]' with value/, "Bad args for hash throws an exception";
  74
  75     throws_ok {
  76         Foo->new( bar => [ a => 'b' ]);
  77     } qr/Attribute \(bar\) does not pass the type constraint because: Validation failed for 'ArrayRef\[Int\]' with value/, "Bad args for array throws an exception";
  78
  79     throws_ok {
  80         Foo->new( complex => [ { a => 1, b => 1 }, { c => "d", e => "f" } ] )
  81     } qr/Attribute \(complex\) does not pass the type constraint because: Validation failed for 'ArrayRef\[HashRef\[Int\]\]' with value/, "Bad args for complex types throws an exception";
  82
  83     throws_ok {
  84         Foo->new( my_class => [ 10 ] );
  85     } qr/Attribute \(my_class\) does not pass the type constraint because: Validation failed for 'ArrayRef\[My::Class\]' with value/;
  86     throws_ok {
  87         Foo->new( my_class => [ {foo => 'bar'} ] );
  88     } qr/Attribute \(my_class\) does not pass the type constraint because: Validation failed for 'ArrayRef\[My::Class\]' with value/;
  89
  90
  91     throws_ok {
  92         Foo->new( my_role => [ 20 ] );
  93     } qr/Attribute \(my_role\) does not pass the type constraint because: Validation failed for 'ArrayRef\[My::Role\]' with value/;
  94     throws_ok {
  95         Foo->new( my_role => [ {foo => 'bar'} ] );
  96     } qr/Attribute \(my_role\) does not pass the type constraint because: Validation failed for 'ArrayRef\[My::Role\]' with value/;
  97 }
  98
  99 {
 100     {
 101         package Bar;
 102         use Mouse;
 103         use Mouse::Util::TypeConstraints;
 104
 105         subtype 'Bar::List'
 106             => as 'ArrayRef[HashRef]'
 107         ;
 108         coerce 'Bar::List'
 109             => from 'ArrayRef[Str]'
 110             => via {
 111                 [ map { +{ $_ => 1 } } @$_ ]
 112             }
 113         ;
 114         has 'list' => (
 115             is => 'ro',
 116             isa => 'Bar::List',
 117             coerce => 1,
 118         );
 119     }
 120
 121     lives_and {
 122         my @list = ( {a => 1}, {b => 1}, {c => 1} );
 123         my $bar = Bar->new(list => [ qw(a b c) ]);
 124
 125         is_deeply( $bar->list, \@list, "list is as expected");
 126     } "coercion works"
 127         or diag( Mouse::Util::TypeConstraints::find_type_constraint("Bar::List")->dump );
 128
 129     throws_ok {
 130         Bar->new(list => [ { 1 => 2 }, 2, 3 ]);
 131     } qr/Attribute \(list\) does not pass the type constraint because: Validation failed for 'Bar::List' with value/, "Bad coercion parameter throws an error";
 132 }
 133
 134 use Mouse::Util::TypeConstraints;
 135
 136 my $t = Mouse::Util::TypeConstraints::find_or_parse_type_constraint('Maybe[Int]');
 137 ok $t->is_a_type_of($t),            "$t is a type of $t";
 138 ok $t->is_a_type_of('Maybe'),       "$t is a type of Maybe";
 139
 140 # XXX: how about 'MaybeInt[ Int ]'?
 141 ok $t->is_a_type_of('Maybe[Int]'),  "$t is a type of Maybe[Int]";
 142
 143 ok!$t->is_a_type_of('Int');
 144
 145 ok $t->check(10);
 146 ok $t->check(undef);
 147 ok!$t->check(3.14);
 148
 149 my $u = subtype 'MaybeInt', as 'Maybe[Int]';
 150 ok $u->is_a_type_of($t),             "$t is a type of $t";
 151 ok $u->is_a_type_of('Maybe'),        "$t is a type of Maybe";
 152
 153 # XXX: how about 'MaybeInt[ Int ]'?
 154 ok $u->is_a_type_of('Maybe[Int]'),   "$t is a type of Maybe[Int]";
 155
 156 ok!$u->is_a_type_of('Int');
 157
 158 ok $u->check(10);
 159 ok $u->check(undef);
 160 ok!$u->check(3.14);
 161
 162 # XXX: undefined hehaviour
 163 # ok $t->is_a_type_of($u);
 164 # ok $u->is_a_type_of($t);
 165
 166 my $w = subtype as 'Maybe[ ArrayRef | HashRef ]';
 167
 168 ok $w->check(undef);
 169 ok $w->check([]);
 170 ok $w->check({});
 171 ok!$w->check(sub{});
 172
 173 ok $w->is_a_type_of('Maybe');
 174 ok $w->is_a_type_of('Maybe[ArrayRef|HashRef]');
 175 ok!$w->is_a_type_of('ArrayRef');
 176
 177 my $x = Mouse::Util::TypeConstraints::find_or_parse_type_constraint('ArrayRef[ ArrayRef[ Int | Undef ] ]');
 178
 179 ok $x->is_a_type_of('ArrayRef');
 180 ok $x->is_a_type_of('ArrayRef[ArrayRef[Int|Undef]]');
 181 ok!$x->is_a_type_of('ArrayRef[ArrayRef[Str]]');
 182
 183 ok $x->check([]);
 184 ok $x->check([[]]);
 185 ok $x->check([[10]]);
 186 ok $x->check([[10, undef]]);
 187 ok!$x->check([[10, 3.14]]);
 188 ok!$x->check({});
 189
 190 $x = tie my @ta, 'Tie::StdArray';
 191
 192 my $array_of_int = Mouse::Util::TypeConstraints::find_or_parse_type_constraint('ArrayRef[Int]');
 193
 194 @$x = (1, 2, 3);
 195 ok $array_of_int->check(\@ta), 'magical array';
 196
 197 @$x = (1, 2, 3.14);
 198 ok !$array_of_int->check(\@ta);
 199
 200 $x = tie my %th, 'Tie::StdHash';
 201
 202 my $hash_of_int = Mouse::Util::TypeConstraints::find_or_parse_type_constraint('HashRef[Int]');
 203
 204 %$x = (foo => 1, bar => 3, baz => 5);
 205 ok $hash_of_int->check(\%th), 'magical hash';
 206
 207 $x->{foo} = 3.14;
 208 ok!$hash_of_int->check(\%th);
 209
 210 my %th_clone;
 211 while(my($k, $v) = each %th){
 212     $th_clone{$k} = $v;
 213 }
 214
 215 is( $hash_of_int->type_parameter, 'Int' );
 216
 217 if('Mouse' eq ('Mo' . 'use')){ # under Mouse
 218     ok $hash_of_int->__is_parameterized();
 219     ok!$hash_of_int->type_parameter->__is_parameterized();
 220 }
 221 else{ # under Moose
 222     ok $hash_of_int->can('type_parameter');
 223     ok!$hash_of_int->type_parameter->can('type_parameter');
 224 }
 225
 226 is_deeply \%th_clone, \%th, 'the hash iterator is initialized';
 227
 228
 229 for my $i(1 .. 2) {
 230     diag "derived from parameterized types #$i";
 231
 232     my $myhashref = subtype 'MyHashRef',
 233         as 'HashRef[Value]',
 234         where { keys %$_ > 1 };
 235
 236     ok  $myhashref->is_a_type_of('HashRef'), "$myhashref";
 237     ok  $myhashref->check({ a => 43, b => 100 });
 238     ok  $myhashref->check({ a => 43, b => 3.14 });
 239     ok !$myhashref->check({});
 240     ok !$myhashref->check({ a => 42, b => [] });
 241
 242     is $myhashref->type_parameter, 'Value';
 243
 244     $myhashref = subtype 'H', as 'MyHashRef[Int]';
 245
 246     ok  $myhashref->is_a_type_of('HashRef'), "$myhashref";
 247     ok  $myhashref->check({ a => 43, b => 100 });
 248     ok  $myhashref->check({ a => 43, b => 100, c => 0 });
 249     ok !$myhashref->check({}), 'empty hash';
 250     ok !$myhashref->check({ foo => 42 });
 251     ok !$myhashref->check({ a => 43, b => "foo" });
 252     ok !$myhashref->check({ a => 42, b => [] });
 253     ok !$myhashref->check({ a => 42, b => undef });
 254     ok !$myhashref->check([42]);
 255     ok !$myhashref->check("foo");
 256
 257     is $myhashref->type_parameter, 'Int';
 258 }
 259
 260 done_testing;
 261