t/040_type_constraints/018_custom_parameterized_types.t

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