t-failing/040_type_constraints/005_util_type_coercion.t

   1 #!/usr/bin/perl
   2 # This is automatically generated by author/import-moose-test.pl.
   3 # DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!!
   4 use t::lib::MooseCompat;
   5
   6 use strict;
   7 use warnings;
   8
   9 use Test::More;
  10 $TODO = q{Mouse is not yet completed};
  11 use Test::Exception;
  12
  13 BEGIN {
  14     use_ok('Mouse::Util::TypeConstraints');
  15 }
  16
  17 {
  18     package HTTPHeader;
  19     use Mouse;
  20
  21     has 'array' => (is => 'ro');
  22     has 'hash'  => (is => 'ro');
  23 }
  24
  25 subtype Header =>
  26     => as Object
  27     => where { $_->isa('HTTPHeader') };
  28
  29 coerce Header
  30     => from ArrayRef
  31         => via { HTTPHeader->new(array => $_[0]) }
  32     => from HashRef
  33         => via { HTTPHeader->new(hash => $_[0]) };
  34
  35
  36 Mouse::Util::TypeConstraints->export_type_constraints_as_functions();
  37
  38 my $header = HTTPHeader->new();
  39 isa_ok($header, 'HTTPHeader');
  40
  41 ok(Header($header), '... this passed the type test');
  42 ok(!Header([]), '... this did not pass the type test');
  43 ok(!Header({}), '... this did not pass the type test');
  44
  45 my $anon_type = subtype Object => where { $_->isa('HTTPHeader') };
  46
  47 lives_ok {
  48     coerce $anon_type
  49         => from ArrayRef
  50             => via { HTTPHeader->new(array => $_[0]) }
  51         => from HashRef
  52             => via { HTTPHeader->new(hash => $_[0]) };
  53 } 'coercion of anonymous subtype succeeds';
  54
  55 foreach my $coercion (
  56     find_type_constraint('Header')->coercion,
  57     $anon_type->coercion
  58     ) {
  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 subtype 'StrWithTrailingX'
  97     => as 'Str'
  98     => where { /X$/ };
  99
 100 coerce 'StrWithTrailingX'
 101     => from 'Str'
 102     => via { $_ . 'X' };
 103
 104 my $tc = find_type_constraint('StrWithTrailingX');
 105 is($tc->coerce("foo"), "fooX", "coerce when needed");
 106 is($tc->coerce("fooX"), "fooX", "do not coerce when unneeded");
 107
 108 done_testing;