t/039-subtype.t

   1 #!/usr/bin/env perl
   2 use strict;
   3 use warnings;
   4 use Test::More tests => 7;
   5 use Test::Exception;
   6
   7 use Mouse::Util::TypeConstraints;
   8
   9 do {
  10     package My::Class;
  11     use Mouse;
  12     use Mouse::Util::TypeConstraints;
  13
  14     subtype 'NonemptyStr'
  15         => as 'Str'
  16         => where { length $_ }
  17         => message { "The string is empty!" };
  18
  19     has name => (
  20         is  => 'ro',
  21         isa => 'NonemptyStr',
  22     );
  23 };
  24
  25 ok(My::Class->new(name => 'foo'));
  26
  27 throws_ok { My::Class->new(name => '') } qr/^Attribute \(name\) does not pass the type constraint because: The string is empty!/;
  28
  29 my $st = subtype as 'Str', where{ length };
  30
  31 ok $st->is_a_type_of('Str');
  32 ok!$st->is_a_type_of('NoemptyStr');
  33
  34 ok $st->check('Foo');
  35 ok!$st->check(undef);
  36 ok!$st->check('');
  37