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