t/001_mouse/801-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::Util::TypeConstraints;
  15
  16     subtype 'HeadersType' => as 'Object' => where { $_->isa('Headers') };
  17     coerce 'HeadersType' =>
  18         from 'ScalarRef' => via {
  19             Headers->new();
  20         },
  21         from 'HashRef' => via {
  22             Headers->new(%{ $_ });
  23         }
  24     ;
  25
  26     has headers => (
  27         is     => 'rw',
  28         isa    => 'HeadersType',
  29         coerce => 1,
  30     );
  31     has lazy_build_coerce_headers => (
  32         is     => 'rw',
  33         isa    => 'HeadersType',
  34         coerce => 1,
  35         lazy_build => 1,
  36     );
  37     sub _build_lazy_build_coerce_headers {
  38         Headers->new(foo => 'laziness++')
  39     }
  40     has lazy_coerce_headers => (
  41         is     => 'rw',
  42         isa    => 'HeadersType',
  43         coerce => 1,
  44         lazy => 1,
  45         default => sub { Headers->new(foo => 'laziness++') }
  46     );
  47 }
  48
  49 my $r = Response->new(headers => { foo => 'bar' });
  50 isa_ok($r->headers, 'Headers');
  51 is($r->headers->foo, 'bar');
  52 $r->headers({foo => 'yay'});
  53 isa_ok($r->headers, 'Headers');
  54 is($r->headers->foo, 'yay');
  55 is($r->lazy_coerce_headers->foo, 'laziness++');
  56 is($r->lazy_build_coerce_headers->foo, 'laziness++');
  57