t/020_attributes/004_attribute_triggers.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Scalar::Util 'isweak';
   7
   8 use Test::More tests => 26;
   9 use Test::Exception;
  10
  11 BEGIN {
  12     use_ok('Moose');
  13 }
  14
  15 {
  16     package Foo;
  17     use Moose;
  18
  19     has 'bar' => (is      => 'rw',
  20                   isa     => 'Maybe[Bar]',
  21                   trigger => sub {
  22                       my ($self, $bar) = @_;
  23                       $bar->foo($self) if defined $bar;
  24                   });
  25
  26     has 'baz' => (writer => 'set_baz',
  27                   reader => 'get_baz',
  28                   isa    => 'Baz',
  29                   trigger => sub {
  30                       my ($self, $baz) = @_;
  31                       $baz->foo($self);
  32                   });
  33
  34
  35     package Bar;
  36     use Moose;
  37
  38     has 'foo' => (is => 'rw', isa => 'Foo', weak_ref => 1);
  39
  40     package Baz;
  41     use Moose;
  42
  43     has 'foo' => (is => 'rw', isa => 'Foo', weak_ref => 1);
  44 }
  45
  46 {
  47     my $foo = Foo->new;
  48     isa_ok($foo, 'Foo');
  49
  50     my $bar = Bar->new;
  51     isa_ok($bar, 'Bar');
  52
  53     my $baz = Baz->new;
  54     isa_ok($baz, 'Baz');
  55
  56     lives_ok {
  57         $foo->bar($bar);
  58     } '... did not die setting bar';
  59
  60     is($foo->bar, $bar, '... set the value foo.bar correctly');
  61     is($bar->foo, $foo, '... which in turn set the value bar.foo correctly');
  62
  63     ok(isweak($bar->{foo}), '... bar.foo is a weak reference');
  64
  65     lives_ok {
  66         $foo->bar(undef);
  67     } '... did not die un-setting bar';
  68
  69     is($foo->bar, undef, '... set the value foo.bar correctly');
  70     is($bar->foo, $foo, '... which in turn set the value bar.foo correctly');
  71
  72     # test the writer
  73
  74     lives_ok {
  75         $foo->set_baz($baz);
  76     } '... did not die setting baz';
  77
  78     is($foo->get_baz, $baz, '... set the value foo.baz correctly');
  79     is($baz->foo, $foo, '... which in turn set the value baz.foo correctly');
  80
  81     ok(isweak($baz->{foo}), '... baz.foo is a weak reference');
  82 }
  83
  84 {
  85     my $bar = Bar->new;
  86     isa_ok($bar, 'Bar');
  87
  88     my $baz = Baz->new;
  89     isa_ok($baz, 'Baz');
  90
  91     my $foo = Foo->new(bar => $bar, baz => $baz);
  92     isa_ok($foo, 'Foo');
  93
  94     is($foo->bar, $bar, '... set the value foo.bar correctly');
  95     is($bar->foo, $foo, '... which in turn set the value bar.foo correctly');
  96
  97     ok(isweak($bar->{foo}), '... bar.foo is a weak reference');
  98
  99     is($foo->get_baz, $baz, '... set the value foo.baz correctly');
 100     is($baz->foo, $foo, '... which in turn set the value baz.foo correctly');
 101
 102     ok(isweak($baz->{foo}), '... baz.foo is a weak reference');
 103 }
 104
 105 # some errors
 106
 107 {
 108     package Bling;
 109     use Moose;
 110
 111     ::dies_ok {
 112         has('bling' => (is => 'rw', trigger => 'Fail'));
 113     } '... a trigger must be a CODE ref';
 114
 115     ::dies_ok {
 116         has('bling' => (is => 'rw', trigger => []));
 117     } '... a trigger must be a CODE ref';
 118 }
 119
 120