t/040_type_constraints/failing/018_custom_parameterized_types.t

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