t/040_type_constraints/005_util_type_coercion.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More tests => 8; # tests => 26;
   7 use Test::Exception;
   8
   9 use lib 't/lib';
  10 use MooseCompat;
  11
  12 BEGIN {
  13         use_ok('Mouse::Util::TypeConstraints');
  14 }
  15
  16 {
  17     package HTTPHeader;
  18     use Mouse;
  19
  20     has 'array' => (is => 'ro');
  21     has 'hash'  => (is => 'ro');
  22 }
  23
  24 subtype Header =>
  25     => as Object
  26     => where { $_->isa('HTTPHeader') };
  27
  28 coerce Header
  29     => from ArrayRef
  30         => via { HTTPHeader->new(array => $_[0]) }
  31     => from HashRef
  32         => via { HTTPHeader->new(hash => $_[0]) };
  33
  34
  35 Mouse::Util::TypeConstraints->export_type_constraints_as_functions();
  36
  37 my $header = HTTPHeader->new();
  38 isa_ok($header, 'HTTPHeader');
  39
  40 ok(Header($header), '... this passed the type test');
  41 ok(!Header([]), '... this did not pass the type test');
  42 ok(!Header({}), '... this did not pass the type test');
  43
  44 my $anon_type = subtype Object => where { $_->isa('HTTPHeader') };
  45
  46 lives_ok {
  47     coerce $anon_type
  48         => from ArrayRef
  49             => via { HTTPHeader->new(array => $_[0]) }
  50         => from HashRef
  51             => via { HTTPHeader->new(hash => $_[0]) };
  52 } 'coercion of anonymous subtype succeeds';
  53
  54 =pod
  55
  56 foreach my $coercion (
  57     find_type_constraint('Header')->coercion,
  58     $anon_type->coercion
  59     ) {
  60     isa_ok($coercion, 'Mouse::Meta::TypeCoercion');
  61
  62     {
  63         my $coerced = $coercion->coerce([ 1, 2, 3 ]);
  64         isa_ok($coerced, 'HTTPHeader');
  65
  66         is_deeply(
  67             $coerced->array(),
  68             [ 1, 2, 3 ],
  69             '... got the right array');
  70         is($coerced->hash(), undef, '... nothing assigned to the hash');
  71     }
  72
  73     {
  74         my $coerced = $coercion->coerce({ one => 1, two => 2, three => 3 });
  75         isa_ok($coerced, 'HTTPHeader');
  76
  77         is_deeply(
  78             $coerced->hash(),
  79             { one => 1, two => 2, three => 3 },
  80             '... got the right hash');
  81         is($coerced->array(), undef, '... nothing assigned to the array');
  82     }
  83
  84     {
  85         my $scalar_ref = \(my $var);
  86         my $coerced = $coercion->coerce($scalar_ref);
  87         is($coerced, $scalar_ref, '... got back what we put in');
  88     }
  89
  90     {
  91         my $coerced = $coercion->coerce("Foo");
  92         is($coerced, "Foo", '... got back what we put in');
  93     }
  94 }
  95
  96 =cut
  97
  98 subtype 'StrWithTrailingX'
  99     => as 'Str'
 100     => where { /X$/ };
 101
 102 coerce 'StrWithTrailingX'
 103     => from 'Str'
 104     => via { $_ . 'X' };
 105
 106 my $tc = find_type_constraint('StrWithTrailingX');
 107 is($tc->coerce("foo"), "fooX", "coerce when needed");
 108 is($tc->coerce("fooX"), "fooX", "do not coerce when unneeded");