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