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 done_testing;