t/056_util_more_type_coercion.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More tests => 26;
   7 use Test::Exception;
   8
   9 BEGIN {
  10     use_ok('Moose');
  11 }
  12
  13 {
  14     package HTTPHeader;
  15     use strict;
  16     use warnings;
  17     use Moose;
  18     use Moose::Util::TypeConstraints;
  19
  20     coerce 'HTTPHeader'
  21         => from ArrayRef
  22             => via { HTTPHeader->new(array => $_[0]) }
  23         => from HashRef
  24             => via { HTTPHeader->new(hash => $_[0]) };
  25
  26     has 'array' => (is => 'ro');
  27     has 'hash'  => (is => 'ro');
  28
  29     package Engine;
  30     use strict;
  31     use warnings;
  32     use Moose;
  33
  34     has 'header' => (is => 'rw', isa => 'HTTPHeader', coerce => 1);
  35 }
  36
  37 {
  38     my $engine = Engine->new();
  39     isa_ok($engine, 'Engine');
  40
  41     # try with arrays
  42
  43     lives_ok {
  44         $engine->header([ 1, 2, 3 ]);
  45     } '... type was coerced without incident';
  46     isa_ok($engine->header, 'HTTPHeader');
  47
  48     is_deeply(
  49         $engine->header->array,
  50         [ 1, 2, 3 ],
  51         '... got the right array value of the header');
  52     ok(!defined($engine->header->hash), '... no hash value set');
  53
  54     # try with hash
  55
  56     lives_ok {
  57         $engine->header({ one => 1, two => 2, three => 3 });
  58     } '... type was coerced without incident';
  59     isa_ok($engine->header, 'HTTPHeader');
  60
  61     is_deeply(
  62         $engine->header->hash,
  63         { one => 1, two => 2, three => 3 },
  64         '... got the right hash value of the header');
  65     ok(!defined($engine->header->array), '... no array value set');
  66
  67     dies_ok {
  68        $engine->header("Foo");
  69     } '... dies with the wrong type, even after coercion';
  70
  71     lives_ok {
  72        $engine->header(HTTPHeader->new);
  73     } '... lives with the right type, even after coercion';
  74 }
  75
  76 {
  77     my $engine = Engine->new(header => [ 1, 2, 3 ]);
  78     isa_ok($engine, 'Engine');
  79
  80     isa_ok($engine->header, 'HTTPHeader');
  81
  82     is_deeply(
  83         $engine->header->array,
  84         [ 1, 2, 3 ],
  85         '... got the right array value of the header');
  86     ok(!defined($engine->header->hash), '... no hash value set');
  87 }
  88
  89 {
  90     my $engine = Engine->new(header => { one => 1, two => 2, three => 3 });
  91     isa_ok($engine, 'Engine');
  92
  93     isa_ok($engine->header, 'HTTPHeader');
  94
  95     is_deeply(
  96         $engine->header->hash,
  97         { one => 1, two => 2, three => 3 },
  98         '... got the right hash value of the header');
  99     ok(!defined($engine->header->array), '... no array value set');
 100 }
 101
 102 {
 103     my $engine = Engine->new(header => HTTPHeader->new());
 104     isa_ok($engine, 'Engine');
 105
 106     isa_ok($engine->header, 'HTTPHeader');
 107
 108     ok(!defined($engine->header->hash), '... no hash value set');
 109     ok(!defined($engine->header->array), '... no array value set');
 110 }
 111
 112 dies_ok {
 113     Engine->new(header => 'Foo');
 114 } '... dies correctly with bad params';
 115
 116 dies_ok {
 117     Engine->new(header => \(my $var));
 118 } '... dies correctly with bad params';
 119