t/type_constraints/duck_types.t

   1 #!/usr/bin/perl
   2 use strict;
   3 use warnings;
   4
   5 use Test::More;
   6 use Test::Fatal;
   7
   8 {
   9
  10     package Duck;
  11     use Moose;
  12
  13     sub quack { }
  14
  15 }
  16
  17 {
  18
  19     package Swan;
  20     use Moose;
  21
  22     sub honk { }
  23
  24 }
  25
  26 {
  27
  28     package RubberDuck;
  29     use Moose;
  30
  31     sub quack { }
  32
  33 }
  34
  35 {
  36
  37     package DucktypeTest;
  38     use Moose;
  39     use Moose::Util::TypeConstraints;
  40
  41     duck_type 'DuckType' => [qw(quack)];
  42     duck_type 'SwanType' => [qw(honk)];
  43
  44     has duck => (
  45         isa        => 'DuckType',
  46         is => 'ro',
  47         lazy_build => 1,
  48     );
  49
  50     sub _build_duck { Duck->new }
  51
  52     has swan => (
  53         isa => duck_type( [qw(honk)] ),
  54         is => 'ro',
  55     );
  56
  57     has other_swan => (
  58         isa => 'SwanType',
  59         is => 'ro',
  60     );
  61
  62 }
  63
  64 # try giving it a duck
  65 is( exception { DucktypeTest->new( duck => Duck->new ) }, undef, 'the Duck lives okay' );
  66
  67 # try giving it a swan which is like a duck, but not close enough
  68 like( exception { DucktypeTest->new( duck => Swan->new ) }, qr/Swan is missing methods 'quack'/, "the Swan doesn't quack" );
  69
  70 # try giving it a rubber RubberDuckey
  71 is( exception { DucktypeTest->new( swan => Swan->new ) }, undef, 'but a Swan can honk' );
  72
  73 # try giving it a rubber RubberDuckey
  74 is( exception { DucktypeTest->new( duck => RubberDuck->new ) }, undef, 'the RubberDuck lives okay' );
  75
  76 # try with the other constraint form
  77 is( exception { DucktypeTest->new( other_swan => Swan->new ) }, undef, 'but a Swan can honk' );
  78
  79 my $re = qr/Validation failed for 'DuckType' with value/;
  80
  81 like( exception { DucktypeTest->new( duck => undef ) }, $re, 'Exception for undef' );
  82 like( exception { DucktypeTest->new( duck => [] ) }, $re, 'Exception for arrayref' );
  83 like( exception { DucktypeTest->new( duck => {} ) }, $re, 'Exception for hashref' );
  84 like( exception { DucktypeTest->new( duck => \'foo' ) }, $re, 'Exception for scalar ref' );
  85
  86 done_testing;