t/type_constraints/coerced_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 BEGIN {
  13     package MyList;
  14     sub new {
  15         my $class = shift;
  16         bless { items => \@_ }, $class;
  17     }
  18
  19     sub items {
  20         my $self = shift;
  21         return @{ $self->{items} };
  22     }
  23 }
  24
  25 subtype 'MyList' => as 'Object' => where { $_->isa('MyList') };
  26
  27 is( exception {
  28     coerce 'ArrayRef'
  29         => from 'MyList'
  30             => via { [ $_->items ] }
  31 }, undef, '... created the coercion okay' );
  32
  33 my $mylist = Moose::Util::TypeConstraints::find_or_parse_type_constraint('MyList[Int]');
  34
  35 ok($mylist->check(MyList->new(10, 20, 30)), '... validated it correctly (pass)');
  36 ok(!$mylist->check(MyList->new(10, "two")), '... validated it correctly (fail)');
  37 ok(!$mylist->check([10]), '... validated it correctly (fail)');
  38
  39 subtype 'EvenList' => as 'MyList' => where { $_->items % 2 == 0 };
  40
  41 # XXX: get this to work *without* the declaration. I suspect it'll be a new
  42 # method in Moose::Meta::TypeCoercion that will look at the parents of the
  43 # coerced type as well. but will that be too "action at a distance"-ey?
  44 is( exception {
  45     coerce 'ArrayRef'
  46         => from 'EvenList'
  47             => via { [ $_->items ] }
  48 }, undef, '... created the coercion okay' );
  49
  50 my $evenlist = Moose::Util::TypeConstraints::find_or_parse_type_constraint('EvenList[Int]');
  51
  52 ok(!$evenlist->check(MyList->new(10, 20, 30)), '... validated it correctly (fail)');
  53 ok($evenlist->check(MyList->new(10, 20, 30, 40)), '... validated it correctly (pass)');
  54 ok(!$evenlist->check(MyList->new(10, "two")), '... validated it correctly (fail)');
  55 ok(!$evenlist->check([10, 20]), '... validated it correctly (fail)');
  56
  57 done_testing;