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::Fatal;
   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     $foo->array( [] );
  68     is_deeply( $foo->array, [], "array - correct contents" );
  69
  70     $foo->push_array('foo');
  71     is_deeply( $foo->array, ['foo'], "array - correct contents" );
  72 }
  73
  74 {
  75     $foo->array_int( [] );
  76     is_deeply( $foo->array_int, [], "array_int - correct contents" );
  77
  78     isnt( exception { $foo->push_array_int('foo') }, undef, "array_int - can't push wrong type" );
  79     is_deeply( $foo->array_int, [], "array_int - correct contents" );
  80
  81     $foo->push_array_int(1);
  82     is_deeply( $foo->array_int, [1], "array_int - correct contents" );
  83 }
  84
  85 {
  86     isnt( exception { $foo->push_a1('foo') }, undef, "a1 - can't push onto undef" );
  87
  88     $foo->a1( [] );
  89     is_deeply( $foo->a1, [], "a1 - correct contents" );
  90
  91     isnt( exception { $foo->push_a1('foo') }, undef, "a1 - can't push wrong type" );
  92
  93     is_deeply( $foo->a1, [], "a1 - correct contents" );
  94
  95     $foo->push_a1(1);
  96     is_deeply( $foo->a1, [1], "a1 - correct contents" );
  97 }
  98
  99 {
 100     isnt( exception { $foo->push_a2('foo') }, undef, "a2 - can't push onto undef" );
 101
 102     $foo->a2( [] );
 103     is_deeply( $foo->a2, [], "a2 - correct contents" );
 104
 105     $foo->push_a2('foo');
 106     is_deeply( $foo->a2, ['foo'], "a2 - correct contents" );
 107
 108     isnt( exception { $foo->push_a2('bar') }, undef, "a2 - can't push more than one element" );
 109
 110     is_deeply( $foo->a2, ['foo'], "a2 - correct contents" );
 111 }
 112
 113 {
 114     isnt( exception { $foo->push_a3(1) }, undef, "a3 - can't push onto undef" );
 115
 116     $foo->a3( [] );
 117     is_deeply( $foo->a3, [], "a3 - correct contents" );
 118
 119     isnt( exception { $foo->push_a3('foo') }, undef, "a3 - can't push non-int" );
 120
 121     isnt( exception { $foo->push_a3(100) }, undef, "a3 - can't violate overall type constraint" );
 122
 123     is_deeply( $foo->a3, [], "a3 - correct contents" );
 124
 125     $foo->push_a3(1);
 126     is_deeply( $foo->a3, [1], "a3 - correct contents" );
 127
 128     isnt( exception { $foo->push_a3(100) }, undef, "a3 - can't violate overall type constraint" );
 129
 130     is_deeply( $foo->a3, [1], "a3 - correct contents" );
 131
 132     $foo->push_a3(3);
 133     is_deeply( $foo->a3, [ 1, 3 ], "a3 - correct contents" );
 134 }
 135
 136 done_testing;