t/054_util_type_coercion.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More tests => 6;
   7 use Test::Exception;
   8
   9 BEGIN {
  10         use_ok('Moose::Util::TypeConstraints');
  11 }
  12
  13 {
  14     package HTTPHeader;
  15     use strict;
  16     use warnings;
  17     use Moose;
  18
  19     has 'array' => (is => 'ro');
  20     has 'hash'  => (is => 'ro');
  21 }
  22
  23 subtype Header =>
  24     => as Object
  25     => where { $_->isa('HTTPHeader') };
  26
  27 coerce Header
  28     => as ArrayRef
  29         => to { HTTPHeader->new(array => $_[0]) }
  30     => as HashRef
  31         => to { HTTPHeader->new(hash => $_[0]) };
  32
  33 Moose::Util::TypeConstraints::export_type_contstraints_as_functions();
  34
  35 my $header = HTTPHeader->new();
  36 isa_ok($header, 'HTTPHeader');
  37
  38 ok(Header($header), '... this passed the type test');
  39 ok(!Header([]), '... this did not pass the type test');
  40 ok(!Header({}), '... this did not pass the type test');
  41
  42 my $coercion = Moose::Util::TypeConstraints::find_type_coercion('Header');
  43 is(ref($coercion), 'CODE', '... got the right type of coercion');
  44
  45 #{
  46 #    my $coerced = $coercion->([ 1, 2, 3 ]);
  47 #    isa_ok($coerced, 'HTTPHeader');
  48 #
  49 #    is_deeply(
  50 #        $coerced->array(),
  51 #        [ 1, 2, 3 ],
  52 #        '... got the right array');
  53 #    is($coerced->hash(), undef, '... nothing assigned to the hash');
  54 #}
  55 #
  56 #{
  57 #    my $coerced = $coercion->({ one => 1, two => 2, three => 3 });
  58 #    isa_ok($coerced, 'HTTPHeader');
  59 #
  60 #    is_deeply(
  61 #        $coerced->hash(),
  62 #        { one => 1, two => 2, three => 3 },
  63 #        '... got the right hash');
  64 #    is($coerced->array(), undef, '... nothing assigned to the array');
  65 #}