t/accessor-trigger.t

   1 use strictures 1;
   2 use Test::More;
   3
   4 our @tr;
   5
   6 sub run_for {
   7   my $class = shift;
   8
   9   @tr = ();
  10
  11   my $obj = $class->new;
  12
  13   ok(!@tr, "${class}: trigger not fired with no value");
  14
  15   $obj = $class->new(one => 1);
  16
  17   is_deeply(\@tr, [ 1 ], "${class}: trigger fired on new");
  18
  19   my $res = $obj->one(2);
  20
  21   is_deeply(\@tr, [ 1, 2 ], "${class}: trigger fired on set");
  22
  23   is($res, 2, "${class}: return from set ok");
  24
  25   is($obj->one, 2, "${class}: return from accessor ok");
  26
  27   is_deeply(\@tr, [ 1, 2 ], "${class}: trigger not fired for accessor as get");
  28 }
  29
  30 {
  31   package Foo;
  32
  33   use Moo;
  34
  35   has one => (is => 'rw', trigger => sub { push @::tr, $_[1] });
  36 }
  37
  38 run_for 'Foo';
  39
  40 {
  41   package Bar;
  42
  43   use Sub::Quote;
  44   use Moo;
  45
  46   has one => (is => 'rw', trigger => quote_sub q{ push @::tr, $_[1] });
  47 }
  48
  49 run_for 'Bar';
  50
  51 {
  52   package Baz;
  53
  54   use Sub::Quote;
  55   use Moo;
  56
  57   has one => (
  58     is => 'rw',
  59     trigger => quote_sub(q{ push @{$tr}, $_[1] }, { '$tr' => \\@::tr })
  60   );
  61 }
  62
  63 run_for 'Baz';
  64
  65 done_testing;