t/001_mouse/806-role_type.t

   1 use strict;
   2 use warnings;
   3 use Test::More tests => 5;
   4
   5 {
   6     package Request::Headers::Role;
   7     use Mouse::Role;
   8     has 'foo' => ( is => 'rw' );
   9 }
  10
  11 {
  12     package Request::Headers;
  13     use Mouse;
  14     with 'Request::Headers::Role';
  15 }
  16
  17 {
  18     package Response::Headers::Role;
  19     use Mouse::Role;
  20     has 'foo' => ( is => 'rw' );
  21 }
  22
  23 {
  24     package Response::Headers;
  25     use Mouse;
  26     with 'Response::Headers::Role';
  27 }
  28
  29 {
  30     package Response;
  31     use Mouse;
  32     use Mouse::Util::TypeConstraints;
  33
  34     role_type Headers => { role => 'Response::Headers::Role' };
  35     coerce 'Headers' =>
  36         from 'HashRef' => via {
  37             Response::Headers->new(%{ $_ });
  38         },
  39     ;
  40
  41     has headers => (
  42         is     => 'rw',
  43         isa    => 'Headers',
  44         coerce => 1,
  45     );
  46 }
  47
  48 my $res = Response->new(headers => { foo => 'bar' });
  49 isa_ok($res->headers, 'Response::Headers');
  50 is($res->headers->foo, 'bar');
  51 $res->headers({foo => 'yay'});
  52 isa_ok($res->headers, 'Response::Headers');
  53 is($res->headers->foo, 'yay');
  54
  55 eval {
  56     $res->headers( Request::Headers->new( foo => 'baz' ) );
  57 };
  58 ok $@;