t/type_constraints/custom_parameterized_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 use Moose::Meta::TypeConstraint::Parameterized;
  11
  12 is( exception {
  13     subtype 'AlphaKeyHash' => as 'HashRef'
  14         => where {
  15             # no keys match non-alpha
  16             (grep { /[^a-zA-Z]/ } keys %$_) == 0
  17         };
  18 }, undef, '... created the subtype special okay' );
  19
  20 is( exception {
  21     subtype 'Trihash' => as 'AlphaKeyHash'
  22         => where {
  23             keys(%$_) == 3
  24         };
  25 }, undef, '... created the subtype special okay' );
  26
  27 is( exception {
  28     subtype 'Noncon' => as 'Item';
  29 }, undef, '... created the subtype special okay' );
  30
  31 {
  32     my $t = find_type_constraint('AlphaKeyHash');
  33     isa_ok($t, 'Moose::Meta::TypeConstraint');
  34
  35     is($t->name, 'AlphaKeyHash', '... name is correct');
  36
  37     my $p = $t->parent;
  38     isa_ok($p, 'Moose::Meta::TypeConstraint');
  39
  40     is($p->name, 'HashRef', '... parent name is correct');
  41
  42     ok($t->check({ one => 1, two => 2 }), '... validated it correctly');
  43     ok(!$t->check({ one1 => 1, two2 => 2 }), '... validated it correctly');
  44
  45     ok( $t->equals($t), "equals to self" );
  46     ok( !$t->equals($t->parent), "not equal to parent" );
  47 }
  48
  49 my $hoi = Moose::Util::TypeConstraints::find_or_parse_type_constraint('AlphaKeyHash[Int]');
  50
  51 ok($hoi->check({ one => 1, two => 2 }), '... validated it correctly');
  52 ok(!$hoi->check({ one1 => 1, two2 => 2 }), '... validated it correctly');
  53 ok(!$hoi->check({ one => 'uno', two => 'dos' }), '... validated it correctly');
  54 ok(!$hoi->check({ one1 => 'un', two2 => 'deux' }), '... validated it correctly');
  55
  56 ok( $hoi->equals($hoi), "equals to self" );
  57 ok( !$hoi->equals($hoi->parent), "equals to self" );
  58 ok( !$hoi->equals(find_type_constraint('AlphaKeyHash')), "not equal to unparametrized self" );
  59 ok( $hoi->equals( Moose::Meta::TypeConstraint::Parameterized->new( name => "Blah", parent => find_type_constraint("AlphaKeyHash"), type_parameter => find_type_constraint("Int") ) ), "equal to clone" );
  60 ok( !$hoi->equals( Moose::Meta::TypeConstraint::Parameterized->new( name => "Oink", parent => find_type_constraint("AlphaKeyHash"), type_parameter => find_type_constraint("Str") ) ), "not equal to different parameter" );
  61
  62 my $th = Moose::Util::TypeConstraints::find_or_parse_type_constraint('Trihash[Bool]');
  63
  64 ok(!$th->check({ one => 1, two => 1 }), '... validated it correctly');
  65 ok($th->check({ one => 1, two => 0, three => 1 }), '... validated it correctly');
  66 ok(!$th->check({ one => 1, two => 2, three => 1 }), '... validated it correctly');
  67 ok(!$th->check({foo1 => 1, bar2 => 0, baz3 => 1}), '... validated it correctly');
  68
  69 isnt( exception {
  70     Moose::Meta::TypeConstraint::Parameterized->new(
  71         name           => 'Str[Int]',
  72         parent         => find_type_constraint('Str'),
  73         type_parameter => find_type_constraint('Int'),
  74     );
  75 }, undef, 'non-containers cannot be parameterized' );
  76
  77 isnt( exception {
  78     Moose::Meta::TypeConstraint::Parameterized->new(
  79         name           => 'Noncon[Int]',
  80         parent         => find_type_constraint('Noncon'),
  81         type_parameter => find_type_constraint('Int'),
  82     );
  83 }, undef, 'non-containers cannot be parameterized' );
  84
  85 done_testing;