t/200_examples/004_example_w_DCS.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More;
   7
   8 =pod
   9
  10 This tests how well Mouse type constraints
  11 play with Declare::Constraints::Simple.
  12
  13 Pretty well if I do say so myself :)
  14
  15 =cut
  16
  17 BEGIN {
  18     eval "use Declare::Constraints::Simple;";
  19     plan skip_all => "Declare::Constraints::Simple is required for this test" if $@;
  20     plan tests => 9;
  21 }
  22
  23 use Test::Exception;
  24
  25 {
  26     package Foo;
  27     use Mouse;
  28     use Mouse::Util::TypeConstraints;
  29     use Declare::Constraints::Simple -All;
  30
  31     # define your own type ...
  32     type( 'HashOfArrayOfObjects',
  33         {
  34         where => IsHashRef(
  35             -keys   => HasLength,
  36             -values => IsArrayRef(IsObject)
  37         )
  38     } );
  39
  40     has 'bar' => (
  41         is  => 'rw',
  42         isa => 'HashOfArrayOfObjects',
  43     );
  44
  45     # inline the constraints as anon-subtypes
  46     has 'baz' => (
  47         is  => 'rw',
  48         isa => subtype( { as => 'ArrayRef', where => IsArrayRef(IsInt) } ),
  49     );
  50
  51     package Bar;
  52     use Mouse;
  53 }
  54
  55 my $hash_of_arrays_of_objs = {
  56    foo1 => [ Bar->new ],
  57    foo2 => [ Bar->new, Bar->new ],
  58 };
  59
  60 my $array_of_ints = [ 1 .. 10 ];
  61
  62 my $foo;
  63 lives_ok {
  64     $foo = Foo->new(
  65        'bar' => $hash_of_arrays_of_objs,
  66        'baz' => $array_of_ints,
  67     );
  68 } '... construction succeeded';
  69 isa_ok($foo, 'Foo');
  70
  71 is_deeply($foo->bar, $hash_of_arrays_of_objs, '... got our value correctly');
  72 is_deeply($foo->baz, $array_of_ints, '... got our value correctly');
  73
  74 dies_ok {
  75     $foo->bar([]);
  76 } '... validation failed correctly';
  77
  78 dies_ok {
  79     $foo->bar({ foo => 3 });
  80 } '... validation failed correctly';
  81
  82 dies_ok {
  83     $foo->bar({ foo => [ 1, 2, 3 ] });
  84 } '... validation failed correctly';
  85
  86 dies_ok {
  87     $foo->baz([ "foo" ]);
  88 } '... validation failed correctly';
  89
  90 dies_ok {
  91     $foo->baz({});
  92 } '... validation failed correctly';
  93