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