t/040_type_constraints/017_subtyping_union_types.t

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