t/040_type_constraints/failing/034_duck_types.t

   1 #!/usr/bin/perl
   2 use strict;
   3 use warnings;
   4
   5 use Test::More tests => 5;
   6 use Test::Exception;
   7
   8 {
   9
  10     package Duck;
  11     use Mouse;
  12
  13     sub quack { }
  14
  15 }
  16
  17 {
  18
  19     package Swan;
  20     use Mouse;
  21
  22     sub honk { }
  23
  24 }
  25
  26 {
  27
  28     package RubberDuck;
  29     use Mouse;
  30
  31     sub quack { }
  32
  33 }
  34
  35 {
  36
  37     package DucktypeTest;
  38     use Mouse;
  39     use Mouse::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 lives_ok { DucktypeTest->new( duck => Duck->new ) } 'the Duck lives okay';
  66
  67 # try giving it a swan which is like a duck, but not close enough
  68 throws_ok { DucktypeTest->new( duck => Swan->new ) }
  69 qr/Swan is missing methods 'quack'/,
  70     "the Swan doesn't quack";
  71
  72 # try giving it a rubber RubberDuckey
  73 lives_ok { DucktypeTest->new( swan => Swan->new ) } 'but a Swan can honk';
  74
  75 # try giving it a rubber RubberDuckey
  76 lives_ok { DucktypeTest->new( duck => RubberDuck->new ) }
  77 'the RubberDuck lives okay';
  78
  79 # try with the other constraint form
  80 lives_ok { DucktypeTest->new( other_swan => Swan->new ) } 'but a Swan can honk';