t/040_type_constraints/017_subtyping_union_types.t

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