t/040_type_constraints/016_subtyping_parameterized_types.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More tests => 18;
   7 use Test::Exception;
   8
   9 BEGIN {
  10     use_ok("Moose::Util::TypeConstraints");
  11 }
  12
  13 lives_ok {
  14     subtype 'MySpecialHash' => as 'HashRef[Int]';
  15 } '... created the subtype special okay';
  16
  17 {
  18     my $t = find_type_constraint('MySpecialHash');
  19     isa_ok($t, 'Moose::Meta::TypeConstraint');
  20
  21     is($t->name, 'MySpecialHash', '... name is correct');
  22
  23     my $p = $t->parent;
  24     isa_ok($p, 'Moose::Meta::TypeConstraint::Parameterized');
  25     isa_ok($p, 'Moose::Meta::TypeConstraint');
  26
  27     is($p->name, 'HashRef[Int]', '... parent name is correct');
  28
  29     ok($t->check({ one => 1, two => 2 }), '... validated it correctly');
  30     ok(!$t->check({ one => "ONE", two => "TWO" }), '... validated it correctly');
  31 }
  32
  33 lives_ok {
  34     subtype 'MySpecialHashExtended'
  35         => as 'HashRef[Int]'
  36         => where {
  37             # all values are less then 10
  38             (scalar grep { $_ < 10 } values %{$_}) ? 1 : undef
  39         };
  40 } '... created the subtype special okay';
  41
  42 {
  43     my $t = find_type_constraint('MySpecialHashExtended');
  44     isa_ok($t, 'Moose::Meta::TypeConstraint');
  45
  46     is($t->name, 'MySpecialHashExtended', '... name is correct');
  47
  48     my $p = $t->parent;
  49     isa_ok($p, 'Moose::Meta::TypeConstraint::Parameterized');
  50     isa_ok($p, 'Moose::Meta::TypeConstraint');
  51
  52     is($p->name, 'HashRef[Int]', '... parent name is correct');
  53
  54     ok($t->check({ one => 1, two => 2 }), '... validated it correctly');
  55     ok(!$t->check({ zero => 10, one => 11, two => 12 }), '... validated it correctly');
  56     ok(!$t->check({ one => "ONE", two => "TWO" }), '... validated it correctly');
  57 }
  58