t/040_type_constraints/007_util_more_type_coercion.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More;
   7 use Test::Exception;
   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     lives_ok {
  41         $engine->header([ 1, 2, 3 ]);
  42     } '... 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     lives_ok {
  54         $engine->header({ one => 1, two => 2, three => 3 });
  55     } '... 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     dies_ok {
  65        $engine->header("Foo");
  66     } '... dies with the wrong type, even after coercion';
  67
  68     lives_ok {
  69        $engine->header(HTTPHeader->new);
  70     } '... 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 dies_ok {
 110     Engine->new(header => 'Foo');
 111 } '... dies correctly with bad params';
 112
 113 dies_ok {
 114     Engine->new(header => \(my $var));
 115 } '... dies correctly with bad params';
 116
 117 done_testing;