xt/moose-accessor-isa.t

   1 use strictures 1;
   2 use Test::More;
   3 use Test::Exception;
   4
   5 use Moo::HandleMoose;
   6
   7 {
   8    package FrewWithIsa;
   9    use Moo::Role;
  10    use Sub::Quote;
  11
  12    has frooh => (
  13       is => 'rw',
  14       isa => sub { die 'not int' unless $_[0] =~ /^\d$/ },
  15    );
  16
  17    has frew => (
  18       is => 'rw',
  19       isa => quote_sub(q{ die 'not int' unless $_[0] =~ /^\d$/ }),
  20    );
  21
  22    package Bar;
  23    use Moose;
  24    with 'FrewWithIsa';
  25
  26    package OffByOne;
  27    use Moo::Role;
  28
  29    has off_by_one => (is => 'rw', coerce => sub { $_[0] + 1 });
  30
  31    package Baz;
  32    use Moo;
  33
  34    with 'OffByOne';
  35
  36    package Quux;
  37    use Moose;
  38
  39    with 'OffByOne';
  40
  41    __PACKAGE__->meta->make_immutable;
  42 }
  43
  44 lives_ok {
  45    Bar->new(frooh => 1, frew => 1);
  46 } 'creation of valid Bar';
  47
  48 dies_ok {
  49    Bar->new(frooh => 'silly', frew => 1);
  50 } 'creation of invalid Bar validated by coderef';
  51
  52 dies_ok {
  53    Bar->new(frooh => 1, frew => 'goose');
  54 } 'creation of invalid Bar validated by quoted sub';
  55
  56 sub test_off_by_one {
  57   my ($class, $type) = @_;
  58
  59   my $obo = $class->new(off_by_one => 1);
  60
  61   is($obo->off_by_one, 2, "Off by one (new) ($type)");
  62
  63   $obo->off_by_one(41);
  64
  65   is($obo->off_by_one, 42, "Off by one (set) ($type)");
  66 }
  67
  68 test_off_by_one('Baz', 'Moo');
  69 test_off_by_one('Quux', 'Moose');
  70
  71 done_testing;