t/040_type_constraints/017_subtyping_union_types.t

   1 #!/usr/bin/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
   6 use strict;
   7 use warnings;
   8
   9 use Test::More;
  10 use Test::Exception;
  11
  12 BEGIN {
  13     use_ok("Mouse::Util::TypeConstraints");
  14 }
  15
  16 lives_ok {
  17     subtype 'MyCollections' => as 'ArrayRef | HashRef';
  18 } '... created the subtype special okay';
  19
  20 {
  21     my $t = find_type_constraint('MyCollections');
  22     isa_ok($t, 'Mouse::Meta::TypeConstraint');
  23
  24     is($t->name, 'MyCollections', '... name is correct');
  25
  26     my $p = $t->parent;
  27     isa_ok($p, 'Mouse::Meta::TypeConstraint');
  28     isa_ok($p, 'Mouse::Meta::TypeConstraint');
  29
  30     is($p->name, 'ArrayRef|HashRef', '... parent name is correct');
  31
  32     ok($t->check([]), '... validated it correctly');
  33     ok($t->check({}), '... validated it correctly');
  34     ok(!$t->check(1), '... validated it correctly');
  35 }
  36
  37 lives_ok {
  38     subtype 'MyCollectionsExtended'
  39         => as 'ArrayRef|HashRef'
  40         => where {
  41             if (ref($_) eq 'ARRAY') {
  42                 return if scalar(@$_) < 2;
  43             }
  44             elsif (ref($_) eq 'HASH') {
  45                 return if scalar(keys(%$_)) < 2;
  46             }
  47             1;
  48         };
  49 } '... created the subtype special okay';
  50
  51 {
  52     my $t = find_type_constraint('MyCollectionsExtended');
  53     isa_ok($t, 'Mouse::Meta::TypeConstraint');
  54
  55     is($t->name, 'MyCollectionsExtended', '... name is correct');
  56
  57     my $p = $t->parent;
  58     isa_ok($p, 'Mouse::Meta::TypeConstraint');
  59     isa_ok($p, 'Mouse::Meta::TypeConstraint');
  60
  61     is($p->name, 'ArrayRef|HashRef', '... parent name is correct');
  62
  63     ok(!$t->check([]), '... validated it correctly');
  64     ok($t->check([1, 2]), '... validated it correctly');
  65
  66     ok(!$t->check({}), '... validated it correctly');
  67     ok($t->check({ one => 1, two => 2 }), '... validated it correctly');
  68
  69     ok(!$t->check(1), '... validated it correctly');
  70 }
  71
  72 done_testing;