t/type_constraints/util_more_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
  10 {
  11     package HTTPHeader;
  12     use Moose;
  13     use Moose::Util::TypeConstraints;
  14
  15     coerce 'HTTPHeader'
  16         => from ArrayRef
  17             => via { HTTPHeader->new(array => $_[0]) };
  18
  19     coerce 'HTTPHeader'
  20         => from HashRef
  21             => via { HTTPHeader->new(hash => $_[0]) };
  22
  23     has 'array' => (is => 'ro');
  24     has 'hash'  => (is => 'ro');
  25
  26     package Engine;
  27     use strict;
  28     use warnings;
  29     use Moose;
  30
  31     has 'header' => (is => 'rw', isa => 'HTTPHeader', coerce => 1);
  32 }
  33
  34 {
  35     my $engine = Engine->new();
  36     isa_ok($engine, 'Engine');
  37
  38     # try with arrays
  39
  40     is( exception {
  41         $engine->header([ 1, 2, 3 ]);
  42     }, undef, '... type was coerced without incident' );
  43     isa_ok($engine->header, 'HTTPHeader');
  44
  45     is_deeply(
  46         $engine->header->array,
  47         [ 1, 2, 3 ],
  48         '... got the right array value of the header');
  49     ok(!defined($engine->header->hash), '... no hash value set');
  50
  51     # try with hash
  52
  53     is( exception {
  54         $engine->header({ one => 1, two => 2, three => 3 });
  55     }, undef, '... type was coerced without incident' );
  56     isa_ok($engine->header, 'HTTPHeader');
  57
  58     is_deeply(
  59         $engine->header->hash,
  60         { one => 1, two => 2, three => 3 },
  61         '... got the right hash value of the header');
  62     ok(!defined($engine->header->array), '... no array value set');
  63
  64     isnt( exception {
  65        $engine->header("Foo");
  66     }, undef, '... dies with the wrong type, even after coercion' );
  67
  68     is( exception {
  69        $engine->header(HTTPHeader->new);
  70     }, undef, '... lives with the right type, even after coercion' );
  71 }
  72
  73 {
  74     my $engine = Engine->new(header => [ 1, 2, 3 ]);
  75     isa_ok($engine, 'Engine');
  76
  77     isa_ok($engine->header, 'HTTPHeader');
  78
  79     is_deeply(
  80         $engine->header->array,
  81         [ 1, 2, 3 ],
  82         '... got the right array value of the header');
  83     ok(!defined($engine->header->hash), '... no hash value set');
  84 }
  85
  86 {
  87     my $engine = Engine->new(header => { one => 1, two => 2, three => 3 });
  88     isa_ok($engine, 'Engine');
  89
  90     isa_ok($engine->header, 'HTTPHeader');
  91
  92     is_deeply(
  93         $engine->header->hash,
  94         { one => 1, two => 2, three => 3 },
  95         '... got the right hash value of the header');
  96     ok(!defined($engine->header->array), '... no array value set');
  97 }
  98
  99 {
 100     my $engine = Engine->new(header => HTTPHeader->new());
 101     isa_ok($engine, 'Engine');
 102
 103     isa_ok($engine->header, 'HTTPHeader');
 104
 105     ok(!defined($engine->header->hash), '... no hash value set');
 106     ok(!defined($engine->header->array), '... no array value set');
 107 }
 108
 109 isnt( exception {
 110     Engine->new(header => 'Foo');
 111 }, undef, '... dies correctly with bad params' );
 112
 113 isnt( exception {
 114     Engine->new(header => \(my $var));
 115 }, undef, '... dies correctly with bad params' );
 116
 117 {
 118     my $tc = Moose::Util::TypeConstraints::find_type_constraint('HTTPHeader');
 119     isa_ok($tc, 'Moose::Meta::TypeConstraint', 'HTTPHeader TC');
 120
 121     my $from_aref = $tc->assert_coerce([ 1, 2, 3 ]);
 122     isa_ok($from_aref, 'HTTPHeader', 'assert_coerce from aref to HTTPHeader');
 123     is_deeply($from_aref->array, [ 1, 2, 3 ], '...and has the right guts');
 124
 125     my $from_href = $tc->assert_coerce({ a => 1 });
 126     isa_ok($from_href, 'HTTPHeader', 'assert_coerce from href to HTTPHeader');
 127     is_deeply($from_href->hash, { a => 1 }, '...and has the right guts');
 128
 129     like( exception { $tc->assert_coerce('total garbage') }, qr/Validation failed for .HTTPHeader./, "assert_coerce throws if result is not acceptable" );
 130 }
 131
 132 done_testing;