t/01-basic.t

   1 use strict;
   2 use warnings;
   3
   4 use Test::More tests=>14;
   5
   6 use_ok 'MooseX::Meta::TypeConstraint::Structured';
   7 use_ok 'Moose::Util::TypeConstraints';
   8
   9 ok my $int = find_type_constraint('Int') => 'Got Int';
  10 ok my $str = find_type_constraint('Str') => 'Got Str';
  11 ok my $arrayref = find_type_constraint('ArrayRef') => 'Got ArrayRef';
  12
  13 my $list_tc = MooseX::Meta::TypeConstraint::Structured->new(
  14     name => 'list_tc',
  15     parent => $arrayref,
  16     type_constraints => [$int, $str],
  17     constraint_generator=> sub {
  18         my ($self) = @_;
  19         my @type_constraints = @{ $self->type_constraints };
  20
  21         return sub {
  22             my ($values, $err) = @_;
  23             my @values = @$values;
  24
  25             for my $type_constraint (@type_constraints) {
  26                 my $value = shift @values || return;
  27                 $type_constraint->check($value) || return;
  28             }
  29             if(@values) {
  30                 return;
  31             } else {
  32                 return 1;
  33             }
  34         }
  35     }
  36 );
  37
  38 isa_ok $list_tc, 'MooseX::Meta::TypeConstraint::Structured';
  39
  40 ok !$arrayref->check() => 'Parent undef fails';
  41 ok !$list_tc->check() => 'undef fails';
  42 ok !$list_tc->check(1) => '1 fails';
  43 ok !$list_tc->check([]) => '[] fails';
  44 ok !$list_tc->check([1]) => '[1] fails';
  45 ok !$list_tc->check([1,2,3]) => '[1,2,3] fails';
  46 ok !$list_tc->check(['a','b']) => '["a","b"] fails';
  47
  48 ok $list_tc->check([1,'a']) => '[1,"a"] passes';