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 use Test::Exception;
  10
  11 {
  12
  13     package Duck;
  14     use Mouse;
  15
  16     sub quack { }
  17
  18 }
  19
  20 {
  21
  22     package Swan;
  23     use Mouse;
  24
  25     sub honk { }
  26
  27 }
  28
  29 {
  30
  31     package RubberDuck;
  32     use Mouse;
  33
  34     sub quack { }
  35
  36 }
  37
  38 {
  39
  40     package DucktypeTest;
  41     use Mouse;
  42     use Mouse::Util::TypeConstraints;
  43
  44     duck_type 'DuckType' => qw(quack);
  45     duck_type 'SwanType' => [qw(honk)];
  46
  47     has duck => (
  48         isa        => 'DuckType',
  49         is => 'ro',
  50         lazy_build => 1,
  51     );
  52
  53     sub _build_duck { Duck->new }
  54
  55     has swan => (
  56         isa => duck_type( [qw(honk)] ),
  57         is => 'ro',
  58     );
  59
  60     has other_swan => (
  61         isa => 'SwanType',
  62         is => 'ro',
  63     );
  64
  65 }
  66
  67 # try giving it a duck
  68 lives_ok { DucktypeTest->new( duck => Duck->new ) } 'the Duck lives okay';
  69
  70 # try giving it a swan which is like a duck, but not close enough
  71 throws_ok { DucktypeTest->new( duck => Swan->new ) }
  72 qr/Swan is missing methods 'quack'/,
  73     "the Swan doesn't quack";
  74
  75 # try giving it a rubber RubberDuckey
  76 lives_ok { DucktypeTest->new( swan => Swan->new ) } 'but a Swan can honk';
  77
  78 # try giving it a rubber RubberDuckey
  79 lives_ok { DucktypeTest->new( duck => RubberDuck->new ) }
  80 'the RubberDuck lives okay';
  81
  82 # try with the other constraint form
  83 lives_ok { DucktypeTest->new( other_swan => Swan->new ) } 'but a Swan can honk';
  84
  85 done_testing;