t/001_mouse/814-subtype-as.t

   1 use strict;
   2 use warnings;
   3 use Test::More tests => 12;
   4 use Scalar::Util qw/blessed/;
   5
   6 {
   7     package Obj1;
   8     sub new { bless {}, shift };
   9 }
  10 {
  11     package Obj2;
  12     use overload '""' => sub { 'Ref' }, fallback => 1;
  13     sub new { bless {}, shift };
  14 }
  15
  16 {
  17     package Foo;
  18     use Mouse;
  19     use Mouse::Util::TypeConstraints;
  20
  21     subtype 'Type1' => as 'Str' => where { blessed($_) };
  22     has str_obj => (
  23         is     => 'rw',
  24         isa    => 'Type1',
  25     );
  26
  27     subtype 'Type2' => as 'Object' => where { $_ eq 'Ref' };
  28     has obj_str => (
  29         is     => 'rw',
  30         isa    => 'Type2',
  31     );
  32
  33     subtype 'Type3' => as 'Object';
  34     has as_only => (
  35         is     => 'rw',
  36         isa    => 'Type3',
  37     );
  38
  39
  40     type 'Type4';
  41     has any => (
  42         is     => 'rw',
  43         isa    => 'Type4',
  44     );
  45 }
  46
  47 eval { Foo->new( str_obj => Obj1->new ) };
  48 like $@, qr/Attribute \(str_obj\) does not pass the type constraint because: Validation failed for 'Type1' failed with value Obj1=HASH/;
  49 eval { Foo->new( obj_str => Obj1->new ) };
  50 like $@, qr/Attribute \(obj_str\) does not pass the type constraint because: Validation failed for 'Type2' failed with value Obj1=HASH/;
  51
  52 eval { Foo->new( str_obj => Obj2->new ) };
  53 like $@, qr/Attribute \(str_obj\) does not pass the type constraint because: Validation failed for 'Type1' failed with value Obj2=HASH/;
  54
  55 eval { Foo->new( str_obj => 'Ref' ) };
  56 like $@, qr/Attribute \(str_obj\) does not pass the type constraint because: Validation failed for 'Type1' failed with value Ref/;
  57
  58 my $f1 = eval { Foo->new( obj_str => Obj2->new ) };
  59 isa_ok $f1, 'Foo';
  60 is $f1->obj_str, 'Ref';
  61
  62 my $f2 = eval { Foo->new( as_only => Obj1->new ) };
  63 isa_ok $f2, 'Foo';
  64 is ref($f2->as_only), 'Obj1';
  65
  66 my $f3 = eval { Foo->new( any => Obj1->new ) };
  67 die $@ if $@;
  68 isa_ok $f3, 'Foo';
  69 is ref($f3->any), 'Obj1';
  70
  71 my $f4 = eval { Foo->new( any => 'YATTA' ) };
  72 isa_ok $f4, 'Foo';
  73 is $f4->any, 'YATTA';