t/800_shikabased/001-coerce.t

   1 use strict;
   2 use warnings;
   3 use Test::More tests => 6;
   4
   5 {
   6     package Headers;
   7     use Mouse;
   8     has 'foo' => ( is => 'rw' );
   9 }
  10
  11 {
  12     package Response;
  13     use Mouse;
  14     use Mouse::TypeRegistry;
  15
  16     subtype 'HeadersType' => sub { defined $_ && eval { $_->isa('Headers') } };
  17     coerce 'HeadersType' => +{
  18         HashRef => sub {
  19             Headers->new(%{ $_ });
  20         },
  21     };
  22
  23     has headers => (
  24         is     => 'rw',
  25         isa    => 'HeadersType',
  26         coerce => 1,
  27     );
  28     has lazy_build_coerce_headers => (
  29         is     => 'rw',
  30         isa    => 'HeadersType',
  31         coerce => 1,
  32         lazy_build => 1,
  33     );
  34     sub _build_lazy_build_coerce_headers {
  35         Headers->new(foo => 'laziness++')
  36     }
  37     has lazy_coerce_headers => (
  38         is     => 'rw',
  39         isa    => 'HeadersType',
  40         coerce => 1,
  41         lazy => 1,
  42         default => sub { Headers->new(foo => 'laziness++') }
  43     );
  44 }
  45
  46 my $r = Response->new(headers => { foo => 'bar' });
  47 isa_ok($r->headers, 'Headers');
  48 is($r->headers->foo, 'bar');
  49 $r->headers({foo => 'yay'});
  50 isa_ok($r->headers, 'Headers');
  51 is($r->headers->foo, 'yay');
  52 is($r->lazy_coerce_headers->foo, 'laziness++');
  53 is($r->lazy_build_coerce_headers->foo, 'laziness++');
  54