t/040_type_constraints/failing/012_container_type_coercion.t

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