t/070_native_traits/300_array_subtypes.t

   1 #!/usr/bin/env 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 use strict;
   6 use warnings;
   7 use Test::More;
   8 use Test::Exception;
   9
  10 {
  11     use Mouse::Util::TypeConstraints;
  12     use List::Util qw(sum);
  13
  14     subtype 'A1', as 'ArrayRef[Int]';
  15     subtype 'A2', as 'ArrayRef',      where { @$_ < 2 };
  16     subtype 'A3', as 'ArrayRef[Int]', where { sum @$_ < 5 };
  17
  18     no Mouse::Util::TypeConstraints;
  19 }
  20
  21 {
  22     package Foo;
  23     use Mouse;
  24
  25     has array => (
  26         traits  => ['Array'],
  27         is      => 'rw',
  28         isa     => 'ArrayRef',
  29         handles => {
  30             push_array => 'push',
  31         },
  32     );
  33     has array_int => (
  34         traits  => ['Array'],
  35         is      => 'rw',
  36         isa     => 'ArrayRef[Int]',
  37         handles => {
  38             push_array_int => 'push',
  39         },
  40     );
  41     has a1 => (
  42         traits  => ['Array'],
  43         is      => 'rw',
  44         isa     => 'A1',
  45         handles => {
  46             push_a1 => 'push',
  47         },
  48     );
  49     has a2 => (
  50         traits  => ['Array'],
  51         is      => 'rw',
  52         isa     => 'A2',
  53         handles => {
  54             push_a2 => 'push',
  55         },
  56     );
  57     has a3 => (
  58         traits  => ['Array'],
  59         is      => 'rw',
  60         isa     => 'A3',
  61         handles => {
  62             push_a3 => 'push',
  63         },
  64     );
  65 }
  66
  67 my $foo = Foo->new;
  68
  69 {
  70     my $array = [];
  71     dies_ok { $foo->push_array('foo') } "can't push onto undef";
  72
  73     $foo->array($array);
  74     is($foo->array, $array, "same ref");
  75     is_deeply($foo->array, [], "correct contents");
  76
  77     $foo->push_array('foo');
  78     is($foo->array, $array, "same ref");
  79     is_deeply($foo->array, ['foo'], "correct contents");
  80 }
  81
  82 {
  83     my $array = [];
  84     dies_ok { $foo->push_array_int(1) } "can't push onto undef";
  85
  86     $foo->array_int($array);
  87     is($foo->array_int, $array, "same ref");
  88     is_deeply($foo->array_int, [], "correct contents");
  89
  90     dies_ok { $foo->push_array_int('foo') } "can't push wrong type";
  91     is($foo->array_int, $array, "same ref");
  92     is_deeply($foo->array_int, [], "correct contents");
  93     @$array = ();
  94
  95     $foo->push_array_int(1);
  96     is($foo->array_int, $array, "same ref");
  97     is_deeply($foo->array_int, [1], "correct contents");
  98 }
  99
 100 {
 101     my $array = [];
 102     dies_ok { $foo->push_a1('foo') } "can't push onto undef";
 103
 104     $foo->a1($array);
 105     is($foo->a1, $array, "same ref");
 106     is_deeply($foo->a1, [], "correct contents");
 107
 108     { local $TODO = "type parameters aren't checked on subtypes";
 109     dies_ok { $foo->push_a1('foo') } "can't push wrong type";
 110     }
 111     is($foo->a1, $array, "same ref");
 112     { local $TODO = "type parameters aren't checked on subtypes";
 113     is_deeply($foo->a1, [], "correct contents");
 114     }
 115     @$array = ();
 116
 117     $foo->push_a1(1);
 118     is($foo->a1, $array, "same ref");
 119     is_deeply($foo->a1, [1], "correct contents");
 120 }
 121
 122 {
 123     my $array = [];
 124     dies_ok { $foo->push_a2('foo') } "can't push onto undef";
 125
 126     $foo->a2($array);
 127     is($foo->a2, $array, "same ref");
 128     is_deeply($foo->a2, [], "correct contents");
 129
 130     $foo->push_a2('foo');
 131     is($foo->a2, $array, "same ref");
 132     is_deeply($foo->a2, ['foo'], "correct contents");
 133
 134     { local $TODO = "overall tcs aren't checked";
 135     dies_ok { $foo->push_a2('bar') } "can't push more than one element";
 136     }
 137     is($foo->a2, $array, "same ref");
 138     { local $TODO = "overall tcs aren't checked";
 139     is_deeply($foo->a2, ['foo'], "correct contents");
 140     }
 141 }
 142
 143 {
 144     my $array = [];
 145     dies_ok { $foo->push_a3(1) } "can't push onto undef";
 146
 147     $foo->a3($array);
 148     is($foo->a3, $array, "same ref");
 149     is_deeply($foo->a3, [], "correct contents");
 150
 151     { local $TODO = "tc parameters aren't checked on subtypes";
 152     dies_ok { $foo->push_a3('foo') } "can't push non-int";
 153     }
 154     { local $TODO = "overall tcs aren't checked";
 155     dies_ok { $foo->push_a3(100) } "can't violate overall type constraint";
 156     }
 157     is($foo->a3, $array, "same ref");
 158     { local $TODO = "tc checks are broken";
 159     is_deeply($foo->a3, [], "correct contents");
 160     }
 161     @$array = ();
 162
 163     $foo->push_a3(1);
 164     is($foo->a3, $array, "same ref");
 165     is_deeply($foo->a3, [1], "correct contents");
 166
 167     { local $TODO = "overall tcs aren't checked";
 168     dies_ok { $foo->push_a3(100) } "can't violate overall type constraint";
 169     }
 170     is($foo->a3, $array, "same ref");
 171     { local $TODO = "overall tcs aren't checked";
 172     is_deeply($foo->a3, [1], "correct contents");
 173     }
 174     @$array = (1);
 175
 176     $foo->push_a3(3);
 177     is($foo->a3, $array, "same ref");
 178     is_deeply($foo->a3, [1, 3], "correct contents");
 179 }
 180
 181 done_testing;