t/800_shikabased/002-coerce_multi_class.t

   1 use strict;
   2 use warnings;
   3 use Test::More tests => 8;
   4
   5 {
   6     package Response::Headers;
   7     use Mouse;
   8     has 'foo' => ( is => 'rw' );
   9 }
  10 {
  11     package Request::Headers;
  12     use Mouse;
  13     has 'foo' => ( is => 'rw' );
  14 }
  15
  16 {
  17     package Response;
  18     use Mouse;
  19     use Mouse::TypeRegistry;
  20
  21     subtype 'Headers' => sub { defined $_ && eval { $_->isa('Response::Headers') } };
  22     coerce 'Headers' => +{
  23         HashRef => sub {
  24             Response::Headers->new(%{ $_ });
  25         },
  26     };
  27
  28     has headers => (
  29         is     => 'rw',
  30         isa    => 'Headers',
  31         coerce => 1,
  32     );
  33 }
  34
  35 {
  36     package Request;
  37     use Mouse;
  38     use Mouse::TypeRegistry;
  39
  40     subtype 'Headers' => sub { defined $_ && eval { $_->isa('Request::Headers') } };
  41     coerce 'Headers' => +{
  42         HashRef => sub {
  43             Request::Headers->new(%{ $_ });
  44         },
  45     };
  46
  47     has headers => (
  48         is     => 'rw',
  49         isa    => 'Headers',
  50         coerce => 1,
  51     );
  52 }
  53
  54 {
  55     package Response;
  56     subtype 'Headers' => sub { defined $_ && eval { $_->isa('Response::Headers') } };
  57     coerce 'Headers' => +{
  58         HashRef => sub {
  59             Response::Headers->new(%{ $_ });
  60         },
  61     };
  62 }
  63
  64 my $req = Request->new(headers => { foo => 'bar' });
  65 isa_ok($req->headers, 'Request::Headers');
  66 is($req->headers->foo, 'bar');
  67 $req->headers({foo => 'yay'});
  68 isa_ok($req->headers, 'Request::Headers');
  69 is($req->headers->foo, 'yay');
  70
  71 my $res = Response->new(headers => { foo => 'bar' });
  72 isa_ok($res->headers, 'Response::Headers');
  73 is($res->headers->foo, 'bar');
  74 $res->headers({foo => 'yay'});
  75 isa_ok($res->headers, 'Response::Headers');
  76 is($res->headers->foo, 'yay');