t/accessor-isa.t

   1 use strictures 1;
   2 use Test::More;
   3 use Test::Fatal;
   4
   5 sub run_for {
   6   my $class = shift;
   7
   8   my $obj = $class->new(less_than_three => 1);
   9
  10   is($obj->less_than_three, 1, "initial value set (${class})");
  11
  12   like(
  13     exception { $obj->less_than_three(4) },
  14     qr/4 is not less than three/, "exception thrown on bad set (${class})"
  15   );
  16
  17   is($obj->less_than_three, 1, "initial value remains after bad set (${class})");
  18
  19   my $ret;
  20
  21   is(
  22     exception { $ret = $obj->less_than_three(2) },
  23     undef, "no exception on correct set (${class})"
  24   );
  25
  26   is($ret, 2, "correct setter return (${class})");
  27   is($obj->less_than_three, 2, "correct getter return (${class})");
  28
  29   is(exception { $class->new }, undef, "no exception with no value (${class})");
  30   like(
  31     exception { $class->new(less_than_three => 12) },
  32     qr/12 is not less than three/,
  33     "exception thrown on bad constructor arg (${class})"
  34   );
  35 }
  36
  37 {
  38   package Foo;
  39
  40   use Moo;
  41
  42   has less_than_three => (
  43     is => 'rw',
  44     isa => sub { die "$_[0] is not less than three" unless $_[0] < 3 }
  45   );
  46 }
  47
  48 run_for 'Foo';
  49
  50 {
  51   package Bar;
  52
  53   use Sub::Quote;
  54   use Moo;
  55
  56   has less_than_three => (
  57     is => 'rw',
  58     isa => quote_sub q{
  59       my ($x) = @_;
  60       die "$x is not less than three" unless $x < 3
  61     }
  62   );
  63 }
  64
  65 run_for 'Bar';
  66
  67 {
  68   package Baz;
  69
  70   use Sub::Quote;
  71   use Moo;
  72
  73   has less_than_three => (
  74     is => 'rw',
  75     isa => quote_sub(
  76       q{
  77         my ($value) = @_;
  78         die "$value is not less than ${word}" unless $value < $limit
  79       },
  80       { '$limit' => \3, '$word' => \'three' }
  81     )
  82   );
  83 }
  84
  85 run_for 'Baz';
  86
  87 done_testing;