t/040_type_constraints/failing/005_util_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('Mouse::Util::TypeConstraints');
  11 }
  12
  13 {
  14     package HTTPHeader;
  15     use Mouse;
  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 Mouse::Util::TypeConstraints->export_type_constraints_as_functions();
  33
  34 my $header = HTTPHeader->new();
  35 isa_ok($header, 'HTTPHeader');
  36
  37 ok(Header($header), '... this passed the type test');
  38 ok(!Header([]), '... this did not pass the type test');
  39 ok(!Header({}), '... this did not pass the type test');
  40
  41 my $anon_type = subtype Object => where { $_->isa('HTTPHeader') };
  42
  43 lives_ok {
  44     coerce $anon_type
  45         => from ArrayRef
  46             => via { HTTPHeader->new(array => $_[0]) }
  47         => from HashRef
  48             => via { HTTPHeader->new(hash => $_[0]) };
  49 } 'coercion of anonymous subtype succeeds';
  50
  51 foreach my $coercion (
  52     find_type_constraint('Header')->coercion,
  53     $anon_type->coercion
  54     ) {
  55
  56     isa_ok($coercion, 'Mouse::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 }
  91
  92 subtype 'StrWithTrailingX'
  93     => as 'Str'
  94     => where { /X$/ };
  95
  96 coerce 'StrWithTrailingX'
  97     => from 'Str'
  98     => via { $_ . 'X' };
  99
 100 my $tc = find_type_constraint('StrWithTrailingX');
 101 is($tc->coerce("foo"), "fooX", "coerce when needed");
 102 is($tc->coerce("fooX"), "fooX", "do not coerce when unneeded");