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 => 10;
   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         lazy => 1,
  30         default => 0,
  31
  32     );
  33
  34 }
  35
  36 lives_ok  { my $goat = Animal->new(leg_count => 4)   } '... no errors thrown, value is good';
  37 lives_ok  { my $spider = Animal->new(leg_count => 8) } '... no errors thrown, value is good';
  38
  39 throws_ok { my $fern = Animal->new(leg_count => 0)  }
  40           qr/This number \(0\) is not less than ten!/,
  41           "gave custom supertype error message on new";
  42
  43 throws_ok { my $centipede = Animal->new(leg_count => 30) }
  44           qr/This number \(30\) is not less than ten!/,
  45           "gave custom subtype error message on new";
  46
  47 my $chimera;
  48 lives_ok { $chimera = Animal->new(leg_count => 4) } '... no errors thrown, value is good';
  49
  50 # first we remove the lion's legs..
  51 throws_ok { $chimera->leg_count(0) }
  52           qr/This number \(0\) is not less than ten!/,
  53           "gave custom supertype error message on set_value";
  54
  55 # mix in a few octopodes
  56 throws_ok { $chimera->leg_count(16) }
  57           qr/This number \(16\) is not less than ten!/,
  58           "gave custom subtype error message on set_value";
  59
  60 # try the lazy legs
  61 my $gimp;
  62 lives_ok  { my $gimp = Animal->new()   } '... no errors thrown, value is good';
  63 throws_ok { $gimp->leg_count }
  64         qr/This number \(0\) is not less than ten!/,
  65         "gave custom supertype error message on set_value";
  66