xt/type-inflate-coercion.t

   1 use strictures 1;
   2 use Test::More;
   3 use Test::Fatal;
   4
   5 sub ArrayRef {
   6   my $type = sub {
   7     die unless ref $_[0] && ref $_[0] eq 'ARRAY';
   8   };
   9   $Moo::HandleMoose::TYPE_MAP{$type} = sub {
  10     require Moose::Util::TypeConstraints;
  11     Moose::Util::TypeConstraints::find_type_constraint("ArrayRef");
  12   };
  13   return ($type, @_);
  14 }
  15
  16 {
  17   package ClassWithTypes;
  18   $INC{'ClassWithTypes.pm'} = __FILE__;
  19   use Moo;
  20
  21   has split_comma => (is => 'ro', isa => ::ArrayRef, coerce => sub { [ split /,/, $_[0] ] } );
  22   has split_space => (is => 'ro', isa => ::ArrayRef, coerce => sub { [ split / /, $_[0] ] } );
  23   has bad_coerce => (is => 'ro', isa => ::ArrayRef, coerce => sub { $_[0] } );
  24 }
  25
  26 my $o = ClassWithTypes->new(split_comma => 'a,b c,d', split_space => 'a,b c,d');
  27 is_deeply $o->split_comma, ['a','b c','d'], 'coerce with prebuilt type works';
  28 is_deeply $o->split_space, ['a,b','c,d'], ' ... and with different coercion on same type';
  29
  30 {
  31   package MooseSubclassWithTypes;
  32   use Moose;
  33   extends 'ClassWithTypes';
  34 }
  35
  36 my $o2 = MooseSubclassWithTypes->new(split_comma => 'a,b c,d', split_space => 'a,b c,d');
  37 is_deeply $o2->split_comma, ['a','b c','d'], 'moose subclass has correct coercion';
  38 is_deeply $o2->split_space, ['a,b','c,d'], ' ... and with different coercion on same type';
  39
  40 like
  41   exception { MooseSubclassWithTypes->new(bad_coerce => 1) },
  42   qr/Validation failed for 'ArrayRef' with value/,
  43   'inflated type has correct name';
  44
  45 done_testing;