t/040_type_constraints/022_custom_type_errors.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More tests => 8;
   7 use Test::Exception;
   8
   9 {
  10     package Animal;
  11     use Moose;
  12     BEGIN {
  13         ::use_ok("Moose::Util::TypeConstraints");
  14     }
  15
  16     subtype 'Natural'
  17         => as 'Int'
  18         => where { $_ > 0 }
  19         => message { "This number ($_) is not a positive integer!" };
  20
  21     subtype 'NaturalLessThanTen'
  22         => as 'Natural'
  23         => where { $_ < 10 }
  24         => message { "This number ($_) is not less than ten!" };
  25
  26     has leg_count => (
  27         is => 'rw',
  28         isa => 'NaturalLessThanTen',
  29     );
  30 }
  31
  32 lives_ok  { my $goat = Animal->new(leg_count => 4)   } '... no errors thrown, value is good';
  33 lives_ok  { my $spider = Animal->new(leg_count => 8) } '... no errors thrown, value is good';
  34
  35 throws_ok { my $fern = Animal->new(leg_count => 0)  }
  36           qr/This number \(0\) is not less than ten!/,
  37           "gave custom supertype error message on new";
  38
  39 throws_ok { my $centipede = Animal->new(leg_count => 30) }
  40           qr/This number \(30\) is not less than ten!/,
  41           "gave custom subtype error message on new";
  42
  43 my $chimera;
  44 lives_ok { $chimera = Animal->new(leg_count => 4) } '... no errors thrown, value is good';
  45
  46 # first we remove the lion's legs..
  47 throws_ok { $chimera->leg_count(0) }
  48           qr/This number \(0\) is not less than ten!/,
  49           "gave custom supertype error message on set_value";
  50
  51 # mix in a few octopodes
  52 throws_ok { $chimera->leg_count(16) }
  53           qr/This number \(16\) is not less than ten!/,
  54           "gave custom subtype error message on set_value";
  55