t/type_constraints/subtyping_union_types.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More;
   7 use Test::Fatal;
   8
   9 use Moose::Util::TypeConstraints;
  10
  11 is( exception {
  12     subtype 'MyCollections' => as 'ArrayRef | HashRef';
  13 }, undef, '... created the subtype special okay' );
  14
  15 {
  16     my $t = find_type_constraint('MyCollections');
  17     isa_ok($t, 'Moose::Meta::TypeConstraint');
  18
  19     is($t->name, 'MyCollections', '... name is correct');
  20
  21     my $p = $t->parent;
  22     isa_ok($p, 'Moose::Meta::TypeConstraint::Union');
  23     isa_ok($p, 'Moose::Meta::TypeConstraint');
  24
  25     is($p->name, 'ArrayRef|HashRef', '... parent name is correct');
  26
  27     ok($t->check([]), '... validated it correctly');
  28     ok($t->check({}), '... validated it correctly');
  29     ok(!$t->check(1), '... validated it correctly');
  30 }
  31
  32 is( exception {
  33     subtype 'MyCollectionsExtended'
  34         => as 'ArrayRef|HashRef'
  35         => where {
  36             if (ref($_) eq 'ARRAY') {
  37                 return if scalar(@$_) < 2;
  38             }
  39             elsif (ref($_) eq 'HASH') {
  40                 return if scalar(keys(%$_)) < 2;
  41             }
  42             1;
  43         };
  44 }, undef, '... created the subtype special okay' );
  45
  46 {
  47     my $t = find_type_constraint('MyCollectionsExtended');
  48     isa_ok($t, 'Moose::Meta::TypeConstraint');
  49
  50     is($t->name, 'MyCollectionsExtended', '... name is correct');
  51
  52     my $p = $t->parent;
  53     isa_ok($p, 'Moose::Meta::TypeConstraint::Union');
  54     isa_ok($p, 'Moose::Meta::TypeConstraint');
  55
  56     is($p->name, 'ArrayRef|HashRef', '... parent name is correct');
  57
  58     ok(!$t->check([]), '... validated it correctly');
  59     ok($t->check([1, 2]), '... validated it correctly');
  60
  61     ok(!$t->check({}), '... validated it correctly');
  62     ok($t->check({ one => 1, two => 2 }), '... validated it correctly');
  63
  64     ok(!$t->check(1), '... validated it correctly');
  65 }
  66
  67 {
  68     my $union = Moose::Util::TypeConstraints::find_or_create_type_constraint('Int|ArrayRef[Int]');
  69     subtype 'UnionSub', as 'Int|ArrayRef[Int]';
  70
  71     my $subtype = find_type_constraint('UnionSub');
  72
  73     ok(
  74         !$union->is_a_type_of('Ref'),
  75         'Int|ArrayRef[Int] is not a type of Ref'
  76     );
  77     ok(
  78         !$subtype->is_a_type_of('Ref'),
  79         'subtype of Int|ArrayRef[Int] is not a type of Ref'
  80     );
  81
  82     ok(
  83         $union->is_a_type_of('Defined'),
  84         'Int|ArrayRef[Int] is a type of Defined'
  85     );
  86     ok(
  87         $subtype->is_a_type_of('Defined'),
  88         'subtype of Int|ArrayRef[Int] is a type of Defined'
  89     );
  90
  91     ok(
  92         !$union->is_subtype_of('Ref'),
  93         'Int|ArrayRef[Int] is not a subtype of Ref'
  94     );
  95     ok(
  96         !$subtype->is_subtype_of('Ref'),
  97         'subtype of Int|ArrayRef[Int] is not a subtype of Ref'
  98     );
  99
 100     ok(
 101         $union->is_subtype_of('Defined'),
 102         'Int|ArrayRef[Int] is a subtype of Defined'
 103     );
 104     ok(
 105         $subtype->is_subtype_of('Defined'),
 106         'subtype of Int|ArrayRef[Int] is a subtype of Defined'
 107     );
 108 }
 109
 110 done_testing;