t/054_util_type_coercion.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More tests => 14;
   7 use Test::Exception;
   8
   9 BEGIN {
  10         use_ok('Moose::Util::TypeConstraints');
  11 }
  12
  13 {
  14     package HTTPHeader;
  15     use strict;
  16     use warnings;
  17     use Moose;
  18
  19     has 'array' => (is => 'ro');
  20     has 'hash'  => (is => 'ro');
  21 }
  22
  23 subtype Header =>
  24     => as Object
  25     => where { $_->isa('HTTPHeader') };
  26
  27 coerce Header
  28     => from ArrayRef
  29         => via { HTTPHeader->new(array => $_[0]) }
  30     => from HashRef
  31         => via { HTTPHeader->new(hash => $_[0]) };
  32
  33
  34 {
  35         package Math::BigFloat;
  36         sub new { bless { }, shift }; # not a moose class ;-)
  37 }
  38
  39 subtype "Math::BigFloat"
  40         => as "Math::BigFloat"
  41         => where { 1 };
  42
  43 coerce "Math::BigFloat"
  44         => from Num
  45                 => via { Math::BigFloat->new( $_ ) };
  46
  47
  48 Moose::Util::TypeConstraints->export_type_contstraints_as_functions();
  49
  50 my $header = HTTPHeader->new();
  51 isa_ok($header, 'HTTPHeader');
  52
  53 ok(Header($header), '... this passed the type test');
  54 ok(!Header([]), '... this did not pass the type test');
  55 ok(!Header({}), '... this did not pass the type test');
  56
  57 my $coercion = find_type_constraint('Header')->coercion;
  58 isa_ok($coercion, 'Moose::Meta::TypeCoercion');
  59
  60 {
  61     my $coerced = $coercion->coerce([ 1, 2, 3 ]);
  62     isa_ok($coerced, 'HTTPHeader');
  63
  64     is_deeply(
  65         $coerced->array(),
  66         [ 1, 2, 3 ],
  67         '... got the right array');
  68     is($coerced->hash(), undef, '... nothing assigned to the hash');
  69 }
  70
  71 {
  72     my $coerced = $coercion->coerce({ one => 1, two => 2, three => 3 });
  73     isa_ok($coerced, 'HTTPHeader');
  74
  75     is_deeply(
  76         $coerced->hash(),
  77         { one => 1, two => 2, three => 3 },
  78         '... got the right hash');
  79     is($coerced->array(), undef, '... nothing assigned to the array');
  80 }
  81
  82 {
  83     my $scalar_ref = \(my $var);
  84     my $coerced = $coercion->coerce($scalar_ref);
  85     is($coerced, $scalar_ref, '... got back what we put in');
  86 }
  87
  88 {
  89     my $coerced = $coercion->coerce("Foo");
  90     is($coerced, "Foo", '... got back what we put in');
  91 }
  92