#!/usr/bin/perl # This is automatically generated by author/import-moose-test.pl. # DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! use t::lib::MooseCompat; use strict; use warnings; use Test::More; use Test::Exception; BEGIN { use_ok("Mouse::Util::TypeConstraints"); use_ok('Mouse::Meta::TypeConstraint'); } lives_ok { subtype 'AlphaKeyHash' => as 'HashRef' => where { # no keys match non-alpha (grep { /[^a-zA-Z]/ } keys %$_) == 0 }; } '... created the subtype special okay'; lives_ok { subtype 'Trihash' => as 'AlphaKeyHash' => where { keys(%$_) == 3 }; } '... created the subtype special okay'; lives_ok { subtype 'Noncon' => as 'Item'; } '... created the subtype special okay'; { my $t = find_type_constraint('AlphaKeyHash'); isa_ok($t, 'Mouse::Meta::TypeConstraint'); is($t->name, 'AlphaKeyHash', '... name is correct'); my $p = $t->parent; isa_ok($p, 'Mouse::Meta::TypeConstraint'); is($p->name, 'HashRef', '... parent name is correct'); ok($t->check({ one => 1, two => 2 }), '... validated it correctly'); ok(!$t->check({ one1 => 1, two2 => 2 }), '... validated it correctly'); local $TODO = 'Mouse does not support equals()'; ok( $t->equals($t), "equals to self" ); ok( !$t->equals($t->parent), "not equal to parent" ); } my $hoi = Mouse::Util::TypeConstraints::find_or_parse_type_constraint('AlphaKeyHash[Int]'); ok($hoi->check({ one => 1, two => 2 }), '... validated it correctly'); ok(!$hoi->check({ one1 => 1, two2 => 2 }), '... validated it correctly'); ok(!$hoi->check({ one => 'uno', two => 'dos' }), '... validated it correctly'); ok(!$hoi->check({ one1 => 'un', two2 => 'deux' }), '... validated it correctly'); { local $TODO = 'Mouse does not support equals()'; ok( $hoi->equals($hoi), "equals to self" ); ok( !$hoi->equals($hoi->parent), "equals to self" ); ok( !$hoi->equals(find_type_constraint('AlphaKeyHash')), "not equal to unparametrized self" ); ok( $hoi->equals( Mouse::Meta::TypeConstraint->new( name => "Blah", parent => find_type_constraint("AlphaKeyHash"), type_parameter => find_type_constraint("Int") ) ), "equal to clone" ); 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" ); } # end TODO my $th = Mouse::Util::TypeConstraints::find_or_parse_type_constraint('Trihash[Bool]'); ok(!$th->check({ one => 1, two => 1 }), '... validated it correctly'); ok($th->check({ one => 1, two => 0, three => 1 }), '... validated it correctly'); ok(!$th->check({ one => 1, two => 2, three => 1 }), '... validated it correctly'); ok(!$th->check({foo1 => 1, bar2 => 0, baz3 => 1}), '... validated it correctly'); dies_ok { Mouse::Meta::TypeConstraint->new( name => 'Str[Int]', parent => find_type_constraint('Str'), type_parameter => find_type_constraint('Int'), ); } 'non-containers cannot be parameterized'; dies_ok { Mouse::Meta::TypeConstraint->new( name => 'Noncon[Int]', parent => find_type_constraint('Noncon'), type_parameter => find_type_constraint('Int'), ); } 'non-containers cannot be parameterized'; done_testing;