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