t/040_type_constraints/034_duck_types.t

   1 #!/usr/bin/perl
   2 # This is automatically generated by author/import-moose-test.pl.
   3 # DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!!
   4 use t::lib::MooseCompat;
   5 use strict;
   6 use warnings;
   7
   8 use Test::More;
   9 $TODO = q{Mouse is not yet completed};
  10 use Test::Exception;
  11
  12 {
  13
  14     package Duck;
  15     use Mouse;
  16
  17     sub quack { }
  18
  19 }
  20
  21 {
  22
  23     package Swan;
  24     use Mouse;
  25
  26     sub honk { }
  27
  28 }
  29
  30 {
  31
  32     package RubberDuck;
  33     use Mouse;
  34
  35     sub quack { }
  36
  37 }
  38
  39 {
  40
  41     package DucktypeTest;
  42     use Mouse;
  43     use Mouse::Util::TypeConstraints;
  44
  45     duck_type 'DuckType' => qw(quack);
  46     duck_type 'SwanType' => [qw(honk)];
  47
  48     has duck => (
  49         isa        => 'DuckType',
  50         is => 'ro',
  51         lazy_build => 1,
  52     );
  53
  54     sub _build_duck { Duck->new }
  55
  56     has swan => (
  57         isa => duck_type( [qw(honk)] ),
  58         is => 'ro',
  59     );
  60
  61     has other_swan => (
  62         isa => 'SwanType',
  63         is => 'ro',
  64     );
  65
  66 }
  67
  68 # try giving it a duck
  69 lives_ok { DucktypeTest->new( duck => Duck->new ) } 'the Duck lives okay';
  70
  71 # try giving it a swan which is like a duck, but not close enough
  72 throws_ok { DucktypeTest->new( duck => Swan->new ) }
  73 qr/Swan is missing methods 'quack'/,
  74     "the Swan doesn't quack";
  75
  76 # try giving it a rubber RubberDuckey
  77 lives_ok { DucktypeTest->new( swan => Swan->new ) } 'but a Swan can honk';
  78
  79 # try giving it a rubber RubberDuckey
  80 lives_ok { DucktypeTest->new( duck => RubberDuck->new ) }
  81 'the RubberDuck lives okay';
  82
  83 # try with the other constraint form
  84 lives_ok { DucktypeTest->new( other_swan => Swan->new ) } 'but a Swan can honk';
  85
  86 done_testing;