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/isa check for "less_than_three" failed: 4 is not less than three/,
  15     "exception thrown on bad set (${class})"
  16   );
  17
  18   is($obj->less_than_three, 1, "initial value remains after bad set (${class})");
  19
  20   my $ret;
  21
  22   is(
  23     exception { $ret = $obj->less_than_three(2) },
  24     undef, "no exception on correct set (${class})"
  25   );
  26
  27   is($ret, 2, "correct setter return (${class})");
  28   is($obj->less_than_three, 2, "correct getter return (${class})");
  29
  30   is(exception { $class->new }, undef, "no exception with no value (${class})");
  31   like(
  32     exception { $class->new(less_than_three => 12) },
  33     qr/isa check for "less_than_three" failed: 12 is not less than three/,
  34     "exception thrown on bad constructor arg (${class})"
  35   );
  36 }
  37
  38 {
  39   package Foo;
  40
  41   use Moo;
  42
  43   has less_than_three => (
  44     is => 'rw',
  45     isa => sub { die "$_[0] is not less than three" unless $_[0] < 3 }
  46   );
  47 }
  48
  49 run_for 'Foo';
  50
  51 {
  52   package Bar;
  53
  54   use Sub::Quote;
  55   use Moo;
  56
  57   has less_than_three => (
  58     is => 'rw',
  59     isa => quote_sub q{
  60       my ($x) = @_;
  61       die "$x is not less than three" unless $x < 3
  62     }
  63   );
  64 }
  65
  66 run_for 'Bar';
  67
  68 {
  69   package Baz;
  70
  71   use Sub::Quote;
  72   use Moo;
  73
  74   has less_than_three => (
  75     is => 'rw',
  76     isa => quote_sub(
  77       q{
  78         my ($value) = @_;
  79         die "$value is not less than ${word}" unless $value < $limit
  80       },
  81       { '$limit' => \3, '$word' => \'three' }
  82     )
  83   );
  84 }
  85
  86 run_for 'Baz';
  87
  88 my $lt3;
  89
  90 {
  91   package LazyFoo;
  92
  93   use Sub::Quote;
  94   use Moo;
  95
  96   has less_than_three => (
  97     is => 'lazy',
  98     isa => quote_sub(q{ die "$_[0] is not less than three" unless $_[0] < 3 })
  99   );
 100
 101   sub _build_less_than_three { $lt3 }
 102 }
 103
 104 $lt3 = 4;
 105
 106 my $lazyfoo = LazyFoo->new;
 107 like(
 108   exception { $lazyfoo->less_than_three },
 109   qr/isa check for "less_than_three" failed: 4 is not less than three/,
 110   "exception thrown on bad builder return value (LazyFoo)"
 111 );
 112
 113 $lt3 = 2;
 114
 115 is(
 116   exception { $lazyfoo->less_than_three },
 117   undef,
 118   'Corrected builder value on existing object returned ok'
 119 );
 120
 121 is(LazyFoo->new->less_than_three, 2, 'Correct builder value returned ok');
 122
 123 done_testing;