t/800_shikabased/801-mousex_types.t

   1 use strict;
   2 use warnings;
   3 use Test::More tests => 16;
   4
   5 {
   6     package Types;
   7     use MouseX::Types -declare => [qw/ Headers /];
   8     use MouseX::Types::Mouse 'HashRef';
   9
  10     type Headers, where { defined $_ && eval { $_->isa('Headers1') } };
  11     coerce Headers,
  12         from HashRef, via {
  13             Headers1->new(%{ $_ });
  14         },
  15     ;
  16 }
  17
  18 {
  19     package Types2;
  20     use MouseX::Types -declare => [qw/ Headers /];
  21     use MouseX::Types::Mouse 'HashRef';
  22
  23     type Headers, where { defined $_ && eval { $_->isa('Headers2') } };
  24     coerce Headers,
  25         from HashRef, via {
  26             Headers2->new(%{ $_ });
  27         },
  28     ;
  29 }
  30
  31 {
  32     package Headers1;
  33     use Mouse;
  34     has 'foo' => ( is => 'rw' );
  35 }
  36
  37 {
  38     package Headers2;
  39     use Mouse;
  40     has 'foo' => ( is => 'rw' );
  41 }
  42
  43 {
  44     package Response;
  45     use Mouse;
  46     BEGIN { Types->import(qw/ Headers /) }
  47
  48     has headers => (
  49         is     => 'rw',
  50         isa    => Headers,
  51         coerce => 1,
  52     );
  53 }
  54
  55 {
  56     package Request;
  57     use Mouse;
  58     BEGIN { Types->import(qw/ Headers /) }
  59
  60     has headers => (
  61         is     => 'rw',
  62         isa    => Headers,
  63         coerce => 1,
  64     );
  65 }
  66
  67 {
  68     package Response2;
  69     use Mouse;
  70     BEGIN { Types2->import(qw/ Headers /) }
  71
  72     has headers => (
  73         is     => 'rw',
  74         isa    => Headers,
  75         coerce => 1,
  76     );
  77 }
  78
  79 {
  80     package Request2;
  81     use Mouse;
  82     BEGIN { Types2->import(qw/ Headers /) }
  83
  84     has headers => (
  85         is     => 'rw',
  86         isa    => Headers,
  87         coerce => 1,
  88     );
  89 }
  90
  91 my $res = Response->new(headers => { foo => 'bar' });
  92 isa_ok($res->headers, 'Headers1');
  93 is($res->headers->foo, 'bar');
  94 $res->headers({foo => 'yay'});
  95 isa_ok($res->headers, 'Headers1');
  96 is($res->headers->foo, 'yay');
  97
  98 my $req = Request->new(headers => { foo => 'bar' });
  99 isa_ok($res->headers, 'Headers1');
 100 is($req->headers->foo, 'bar');
 101 $req->headers({foo => 'yay'});
 102 isa_ok($res->headers, 'Headers1');
 103 is($req->headers->foo, 'yay');
 104
 105 $res = Response2->new(headers => { foo => 'bar' });
 106 isa_ok($res->headers, 'Headers2');
 107 is($res->headers->foo, 'bar');
 108 $res->headers({foo => 'yay'});
 109 isa_ok($res->headers, 'Headers2');
 110 is($res->headers->foo, 'yay');
 111
 112 $req = Request2->new(headers => { foo => 'bar' });
 113 isa_ok($res->headers, 'Headers2');
 114 is($req->headers->foo, 'bar');
 115 $req->headers({foo => 'yay'});
 116 isa_ok($res->headers, 'Headers2');
 117 is($req->headers->foo, 'yay');
 118