t/type_constraints/util_type_coercion.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More;
   7 use Test::Fatal;
   8
   9 use Moose::Util::TypeConstraints;
  10
  11 {
  12     package HTTPHeader;
  13     use Moose;
  14
  15     has 'array' => (is => 'ro');
  16     has 'hash'  => (is => 'ro');
  17 }
  18
  19 subtype Header =>
  20     => as Object
  21     => where { $_->isa('HTTPHeader') };
  22
  23 coerce Header
  24     => from ArrayRef
  25         => via { HTTPHeader->new(array => $_[0]) }
  26     => from HashRef
  27         => via { HTTPHeader->new(hash => $_[0]) };
  28
  29
  30 Moose::Util::TypeConstraints->export_type_constraints_as_functions();
  31
  32 my $header = HTTPHeader->new();
  33 isa_ok($header, 'HTTPHeader');
  34
  35 ok(Header($header), '... this passed the type test');
  36 ok(!Header([]), '... this did not pass the type test');
  37 ok(!Header({}), '... this did not pass the type test');
  38
  39 my $anon_type = subtype Object => where { $_->isa('HTTPHeader') };
  40
  41 is( exception {
  42     coerce $anon_type
  43         => from ArrayRef
  44             => via { HTTPHeader->new(array => $_[0]) }
  45         => from HashRef
  46             => via { HTTPHeader->new(hash => $_[0]) };
  47 }, undef, 'coercion of anonymous subtype succeeds' );
  48
  49 foreach my $coercion (
  50     find_type_constraint('Header')->coercion,
  51     $anon_type->coercion
  52     ) {
  53
  54     isa_ok($coercion, 'Moose::Meta::TypeCoercion');
  55
  56     {
  57         my $coerced = $coercion->coerce([ 1, 2, 3 ]);
  58         isa_ok($coerced, 'HTTPHeader');
  59
  60         is_deeply(
  61             $coerced->array(),
  62             [ 1, 2, 3 ],
  63             '... got the right array');
  64         is($coerced->hash(), undef, '... nothing assigned to the hash');
  65     }
  66
  67     {
  68         my $coerced = $coercion->coerce({ one => 1, two => 2, three => 3 });
  69         isa_ok($coerced, 'HTTPHeader');
  70
  71         is_deeply(
  72             $coerced->hash(),
  73             { one => 1, two => 2, three => 3 },
  74             '... got the right hash');
  75         is($coerced->array(), undef, '... nothing assigned to the array');
  76     }
  77
  78     {
  79         my $scalar_ref = \(my $var);
  80         my $coerced = $coercion->coerce($scalar_ref);
  81         is($coerced, $scalar_ref, '... got back what we put in');
  82     }
  83
  84     {
  85         my $coerced = $coercion->coerce("Foo");
  86         is($coerced, "Foo", '... got back what we put in');
  87     }
  88 }
  89
  90 subtype 'StrWithTrailingX'
  91     => as 'Str'
  92     => where { /X$/ };
  93
  94 coerce 'StrWithTrailingX'
  95     => from 'Str'
  96     => via { $_ . 'X' };
  97
  98 my $tc = find_type_constraint('StrWithTrailingX');
  99 is($tc->coerce("foo"), "fooX", "coerce when needed");
 100 is($tc->coerce("fooX"), "fooX", "do not coerce when unneeded");
 101
 102 done_testing;