t/type_constraints/container_type_coercion.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More;
   7
   8 use Moose::Util::TypeConstraints;
   9 use Moose::Meta::TypeConstraint::Parameterized;
  10
  11 my $r = Moose::Util::TypeConstraints->get_type_constraint_registry;
  12
  13 # Array of Ints
  14
  15 my $array_of_ints = Moose::Meta::TypeConstraint::Parameterized->new(
  16     name           => 'ArrayRef[Int]',
  17     parent         => find_type_constraint('ArrayRef'),
  18     type_parameter => find_type_constraint('Int'),
  19 );
  20 isa_ok($array_of_ints, 'Moose::Meta::TypeConstraint::Parameterized');
  21 isa_ok($array_of_ints, 'Moose::Meta::TypeConstraint');
  22
  23 $r->add_type_constraint($array_of_ints);
  24
  25 is(find_type_constraint('ArrayRef[Int]'), $array_of_ints, '... found the type we just added');
  26
  27 # Hash of Ints
  28
  29 my $hash_of_ints = Moose::Meta::TypeConstraint::Parameterized->new(
  30     name           => 'HashRef[Int]',
  31     parent         => find_type_constraint('HashRef'),
  32     type_parameter => find_type_constraint('Int'),
  33 );
  34 isa_ok($hash_of_ints, 'Moose::Meta::TypeConstraint::Parameterized');
  35 isa_ok($hash_of_ints, 'Moose::Meta::TypeConstraint');
  36
  37 $r->add_type_constraint($hash_of_ints);
  38
  39 is(find_type_constraint('HashRef[Int]'), $hash_of_ints, '... found the type we just added');
  40
  41 ## now attempt a coercion
  42
  43 {
  44     package Foo;
  45     use Moose;
  46     use Moose::Util::TypeConstraints;
  47
  48     coerce 'ArrayRef[Int]'
  49         => from 'HashRef[Int]'
  50             => via { [ values %$_ ] };
  51
  52     has 'bar' => (
  53         is     => 'ro',
  54         isa    => 'ArrayRef[Int]',
  55         coerce => 1,
  56     );
  57
  58 }
  59
  60 my $foo = Foo->new(bar => { one => 1, two => 2, three => 3 });
  61 isa_ok($foo, 'Foo');
  62
  63 is_deeply([ sort @{$foo->bar} ], [ 1, 2, 3 ], '... our coercion worked!');
  64
  65 done_testing;