6 use Scalar::Util 'isweak';
8 use Test::More tests => 36;
17 has 'bar' => (is => 'rw',
20 my ($self, $bar) = @_;
21 $bar->foo($self) if defined $bar;
24 has 'baz' => (writer => 'set_baz',
28 my ($self, $baz) = @_;
36 has 'foo' => (is => 'rw', isa => 'Foo', weak_ref => 1);
41 has 'foo' => (is => 'rw', isa => 'Foo', weak_ref => 1);
56 } '... did not die setting bar';
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');
61 ok(isweak($bar->{foo}), '... bar.foo is a weak reference');
65 } '... did not die un-setting bar';
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');
74 } '... did not die setting baz';
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');
79 ok(isweak($baz->{foo}), '... baz.foo is a weak reference');
89 my $foo = Foo->new(bar => $bar, baz => $baz);
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');
95 ok(isweak($bar->{foo}), '... bar.foo is a weak reference');
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');
100 ok(isweak($baz->{foo}), '... baz.foo is a weak reference');
110 has('bling' => (is => 'rw', trigger => 'Fail'));
111 } '... a trigger must be a CODE ref';
114 has('bling' => (is => 'rw', trigger => []));
115 } '... a trigger must be a CODE ref';
118 # Triggers do not fire on built values
126 has foo => (is => 'rw', default => sub { 'default foo value' },
127 trigger => sub { my ($self, $val, $attr) = @_;
128 $trigger_calls{foo}++;
129 $trigger_vals{foo} = $val });
130 has bar => (is => 'rw', lazy_build => 1,
131 trigger => sub { my ($self, $val, $attr) = @_;
132 $trigger_calls{bar}++;
133 $trigger_vals{bar} = $val });
134 sub _build_bar { return 'default bar value' }
135 has baz => (is => 'rw', builder => '_build_baz',
136 trigger => sub { my ($self, $val, $attr) = @_;
137 $trigger_calls{baz}++;
138 $trigger_vals{baz} = $val });
139 sub _build_baz { return 'default baz value' }
144 lives_ok { $blarg = Blarg->new; } 'Blarg->new() lives';
145 ok($blarg, 'Have a $blarg');
146 foreach my $attr (qw/foo bar baz/) {
147 is($blarg->$attr(), "default $attr value", "$attr has default value");
149 is_deeply(\%Blarg::trigger_calls, {}, 'No triggers fired');
150 foreach my $attr (qw/foo bar baz/) {
151 $blarg->$attr("Different $attr value");
153 is_deeply(\%Blarg::trigger_calls, { map { $_ => 1 } qw/foo bar baz/ }, 'All triggers fired once on assign');
154 is_deeply(\%Blarg::trigger_vals, { map { $_ => "Different $_ value" } qw/foo bar baz/ }, 'All triggers given assigned values');
156 lives_ok { $blarg => Blarg->new( map { $_ => "Yet another $_ value" } qw/foo bar baz/ ) } '->new() with parameters';
157 is_deeply(\%Blarg::trigger_calls, { map { $_ => 2 } qw/foo bar baz/ }, 'All triggers fired once on construct');
158 is_deeply(\%Blarg::trigger_vals, { map { $_ => "Yet another $_ value" } qw/foo bar baz/ }, 'All triggers given assigned values');