t/040_type_constraints/019_coerced_parameterized_types.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More tests => 11;
   7 use Test::Exception;
   8
   9 BEGIN {
  10     use_ok("Moose::Util::TypeConstraints");
  11     use_ok('Moose::Meta::TypeConstraint::Parameterized');
  12 }
  13
  14 BEGIN {
  15     package MyList;
  16     sub new {
  17         my $class = shift;
  18         bless { items => \@_ }, $class;
  19     }
  20
  21     sub items {
  22         my $self = shift;
  23         return @{ $self->{items} };
  24     }
  25 }
  26
  27 subtype 'MyList' => as 'Object' => where { $_->isa('MyList') };
  28
  29 lives_ok {
  30     coerce 'ArrayRef'
  31         => from 'MyList'
  32             => via { [ $_->items ] }
  33 } '... created the coercion okay';
  34
  35 my $mylist = Moose::Meta::TypeConstraint::Parameterized->new(
  36     name           => 'MyList[Int]',
  37     parent         => find_type_constraint('MyList'),
  38     type_parameter => find_type_constraint('Int'),
  39 );
  40
  41 ok($mylist->check(MyList->new(10, 20, 30)), '... validated it correctly');
  42 ok(!$mylist->check(MyList->new(10, "two")), '... validated it correctly');
  43 ok(!$mylist->check([10]), '... validated it correctly');
  44
  45 subtype 'EvenList' => as 'MyList' => where { $_->items % 2 == 0 };
  46
  47 # XXX: get this to work *without* the declaration. I suspect it'll be a new
  48 # method in Moose::Meta::TypeCoercion that will look at the parents of the
  49 # coerced type as well. but will that be too "action at a distance"-ey?
  50 lives_ok {
  51     coerce 'ArrayRef'
  52         => from 'EvenList'
  53             => via { [ $_->items ] }
  54 } '... created the coercion okay';
  55
  56 my $evenlist = Moose::Meta::TypeConstraint::Parameterized->new(
  57     name           => 'EvenList[Int]',
  58     parent         => find_type_constraint('EvenList'),
  59     type_parameter => find_type_constraint('Int'),
  60 );
  61
  62 ok(!$evenlist->check(MyList->new(10, 20, 30)), '... validated it correctly');
  63 ok($evenlist->check(MyList->new(10, 20, 30, 40)), '... validated it correctly');
  64 ok(!$evenlist->check(MyList->new(10, "two")), '... validated it correctly');
  65 ok(!$evenlist->check([10, 20]), '... validated it correctly');
  66