t-failing/040_type_constraints/012_container_type_coercion.t

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