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