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 => 21;
   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     ok( $t->equals($t), "equals to self" );
  33     ok( !$t->equals( $t->parent ), "not equal to parent" );
  34     ok( $t->parent->equals( $t->parent ), "parent equals to self" );
  35 }
  36
  37 lives_ok {
  38     subtype 'MySpecialHashExtended'
  39         => as 'HashRef[Int]'
  40         => where {
  41             # all values are less then 10
  42             (scalar grep { $_ < 10 } values %{$_}) ? 1 : undef
  43         };
  44 } '... created the subtype special okay';
  45
  46 {
  47     my $t = find_type_constraint('MySpecialHashExtended');
  48     isa_ok($t, 'Moose::Meta::TypeConstraint');
  49
  50     is($t->name, 'MySpecialHashExtended', '... name is correct');
  51
  52     my $p = $t->parent;
  53     isa_ok($p, 'Moose::Meta::TypeConstraint::Parameterized');
  54     isa_ok($p, 'Moose::Meta::TypeConstraint');
  55
  56     is($p->name, 'HashRef[Int]', '... parent name is correct');
  57
  58     ok($t->check({ one => 1, two => 2 }), '... validated it correctly');
  59     ok(!$t->check({ zero => 10, one => 11, two => 12 }), '... validated it correctly');
  60     ok(!$t->check({ one => "ONE", two => "TWO" }), '... validated it correctly');
  61 }
  62