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