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 => 18;
   7 use Test::Exception;
   8
   9 {
  10     package Animal;
  11     use Moose;
  12     use Moose::Util::TypeConstraints;
  13
  14     subtype 'Natural' => as 'Int' => where { $_ > 0 } =>
  15         message {"This number ($_) is not a positive integer!"};
  16
  17     subtype 'NaturalLessThanTen' => as 'Natural' => where { $_ < 10 } =>
  18         message {"This number ($_) is not less than ten!"};
  19
  20     has leg_count => (
  21         is      => 'rw',
  22         isa     => 'NaturalLessThanTen',
  23         lazy    => 1,
  24         default => 0,
  25     );
  26 }
  27
  28 run_tests();
  29 Animal->meta->make_immutable;
  30 run_tests();
  31
  32 sub run_tests {
  33     lives_ok { my $goat = Animal->new( leg_count => 4 ) }
  34     '... no errors thrown, value is good';
  35     lives_ok { my $spider = Animal->new( leg_count => 8 ) }
  36     '... no errors thrown, value is good';
  37
  38     throws_ok { my $fern = Animal->new( leg_count => 0 ) }
  39     qr/This number \(0\) is not less than ten!/,
  40         'gave custom supertype error message on new';
  41
  42     throws_ok { my $centipede = Animal->new( leg_count => 30 ) }
  43     qr/This number \(30\) is not less than ten!/,
  44         'gave custom subtype error message on new';
  45
  46     my $chimera;
  47     lives_ok { $chimera = Animal->new( leg_count => 4 ) }
  48     '... no errors thrown, value is good';
  49
  50     throws_ok { $chimera->leg_count(0) }
  51     qr/This number \(0\) is not less than ten!/,
  52         'gave custom supertype error message on set to 0';
  53
  54     throws_ok { $chimera->leg_count(16) }
  55     qr/This number \(16\) is not less than ten!/,
  56         'gave custom subtype error message on set to 16';
  57
  58     my $gimp = eval { Animal->new() };
  59     is( $@, '', '... no errors thrown, value is good' );
  60
  61     throws_ok { $gimp->leg_count }
  62     qr/This number \(0\) is not less than ten!/,
  63         'gave custom supertype error message on lazy set to 0';
  64 }