t/070_native_traits/011_array_subtypes.t

   1 #!/usr/bin/env perl
   2 use strict;
   3 use warnings;
   4 use Test::More;
   5 use Test::Exception;
   6
   7 {
   8     use Moose::Util::TypeConstraints;
   9     use List::Util qw(sum);
  10
  11     subtype 'A1', as 'ArrayRef[Int]';
  12     subtype 'A2', as 'ArrayRef', where { @$_ < 2 };
  13     subtype 'A3', as 'ArrayRef[Int]', where { ( sum(@$_) || 0 ) < 5 };
  14
  15     no Moose::Util::TypeConstraints;
  16 }
  17
  18 {
  19     package Foo;
  20     use Moose;
  21
  22     has array => (
  23         traits  => ['Array'],
  24         is      => 'rw',
  25         isa     => 'ArrayRef',
  26         handles => {
  27             push_array => 'push',
  28         },
  29     );
  30     has array_int => (
  31         traits  => ['Array'],
  32         is      => 'rw',
  33         isa     => 'ArrayRef[Int]',
  34         handles => {
  35             push_array_int => 'push',
  36         },
  37     );
  38     has a1 => (
  39         traits  => ['Array'],
  40         is      => 'rw',
  41         isa     => 'A1',
  42         handles => {
  43             push_a1 => 'push',
  44         },
  45     );
  46     has a2 => (
  47         traits  => ['Array'],
  48         is      => 'rw',
  49         isa     => 'A2',
  50         handles => {
  51             push_a2 => 'push',
  52         },
  53     );
  54     has a3 => (
  55         traits  => ['Array'],
  56         is      => 'rw',
  57         isa     => 'A3',
  58         handles => {
  59             push_a3 => 'push',
  60         },
  61     );
  62 }
  63
  64 my $foo = Foo->new;
  65
  66 {
  67     dies_ok { $foo->push_array('foo') } "array - can't push onto undef";
  68
  69     $foo->array( [] );
  70     is_deeply( $foo->array, [], "array - correct contents" );
  71
  72     $foo->push_array('foo');
  73     is_deeply( $foo->array, ['foo'], "array - correct contents" );
  74 }
  75
  76 {
  77     dies_ok { $foo->push_array_int(1) } "array_int - can't push onto undef";
  78
  79     $foo->array_int( [] );
  80     is_deeply( $foo->array_int, [], "array_int - correct contents" );
  81
  82     dies_ok { $foo->push_array_int('foo') }
  83     "array_int - can't push wrong type";
  84     is_deeply( $foo->array_int, [], "array_int - correct contents" );
  85
  86     $foo->push_array_int(1);
  87     is_deeply( $foo->array_int, [1], "array_int - correct contents" );
  88 }
  89
  90 {
  91     dies_ok { $foo->push_a1('foo') } "a1 - can't push onto undef";
  92
  93     $foo->a1( [] );
  94     is_deeply( $foo->a1, [], "a1 - correct contents" );
  95
  96     dies_ok { $foo->push_a1('foo') } "a1 - can't push wrong type";
  97
  98     is_deeply( $foo->a1, [], "a1 - correct contents" );
  99
 100     $foo->push_a1(1);
 101     is_deeply( $foo->a1, [1], "a1 - correct contents" );
 102 }
 103
 104 {
 105     dies_ok { $foo->push_a2('foo') } "a2 - can't push onto undef";
 106
 107     $foo->a2( [] );
 108     is_deeply( $foo->a2, [], "a2 - correct contents" );
 109
 110     $foo->push_a2('foo');
 111     is_deeply( $foo->a2, ['foo'], "a2 - correct contents" );
 112
 113     dies_ok { $foo->push_a2('bar') } "a2 - can't push more than one element";
 114
 115     is_deeply( $foo->a2, ['foo'], "a2 - correct contents" );
 116 }
 117
 118 {
 119     dies_ok { $foo->push_a3(1) } "a3 - can't push onto undef";
 120
 121     $foo->a3( [] );
 122     is_deeply( $foo->a3, [], "a3 - correct contents" );
 123
 124     dies_ok { $foo->push_a3('foo') } "a3 - can't push non-int";
 125
 126     dies_ok { $foo->push_a3(100) }
 127     "a3 - can't violate overall type constraint";
 128
 129     is_deeply( $foo->a3, [], "a3 - correct contents" );
 130
 131     $foo->push_a3(1);
 132     is_deeply( $foo->a3, [1], "a3 - correct contents" );
 133
 134     dies_ok { $foo->push_a3(100) }
 135     "a3 - can't violate overall type constraint";
 136
 137     is_deeply( $foo->a3, [1], "a3 - correct contents" );
 138
 139     $foo->push_a3(3);
 140     is_deeply( $foo->a3, [ 1, 3 ], "a3 - correct contents" );
 141 }
 142
 143 done_testing;