use Scalar::Util 'isweak';
-use Test::More tests => 43;
+use Test::More tests => 40;
use Test::Exception;
-BEGIN {
- use_ok('Moose');
-}
+
{
package Foo;
use Moose;
-
- has 'bar' => (is => 'rw',
+
+ has 'bar' => (is => 'rw',
isa => 'Maybe[Bar]',
- trigger => sub {
+ trigger => sub {
my ($self, $bar) = @_;
$bar->foo($self) if defined $bar;
});
-
+
has 'baz' => (writer => 'set_baz',
reader => 'get_baz',
isa => 'Baz',
- trigger => sub {
+ trigger => sub {
my ($self, $baz) = @_;
$baz->foo($self);
- });
-
-
+ });
+
+
package Bar;
use Moose;
-
- has 'foo' => (is => 'rw', isa => 'Foo', weak_ref => 1);
-
+
+ has 'foo' => (is => 'rw', isa => 'Foo', weak_ref => 1);
+
package Baz;
use Moose;
-
- has 'foo' => (is => 'rw', isa => 'Foo', weak_ref => 1);
+
+ has 'foo' => (is => 'rw', isa => 'Foo', weak_ref => 1);
}
{
is($bar->foo, $foo, '... which in turn set the value bar.foo correctly');
ok(isweak($bar->{foo}), '... bar.foo is a weak reference');
-
+
lives_ok {
$foo->bar(undef);
} '... did not die un-setting bar';
is($foo->bar, undef, '... set the value foo.bar correctly');
- is($bar->foo, $foo, '... which in turn set the value bar.foo correctly');
+ is($bar->foo, $foo, '... which in turn set the value bar.foo correctly');
# test the writer
my $baz = Baz->new;
isa_ok($baz, 'Baz');
-
+
my $foo = Foo->new(bar => $bar, baz => $baz);
- isa_ok($foo, 'Foo');
+ isa_ok($foo, 'Foo');
is($foo->bar, $bar, '... set the value foo.bar correctly');
is($bar->foo, $foo, '... which in turn set the value bar.foo correctly');
ok(isweak($baz->{foo}), '... baz.foo is a weak reference');
}
-# before/around/after triggers
+# some errors
+
{
- package Fweet;
+ package Bling;
use Moose;
- has calls => (
- is => 'ro',
- isa => 'ArrayRef',
- default => sub {[]},
- );
-
- sub called {
- my ($self, $str, @args) = @_;
- push(@{$self->calls}, $str);
- }
+ ::dies_ok {
+ has('bling' => (is => 'rw', trigger => 'Fail'));
+ } '... a trigger must be a CODE ref';
- has noise => (
- is => 'rw',
- default => 'Sartak',
- trigger => {
- before => sub {
- $_[0]->called('before');
- },
- around => sub {
- my ($ori, $self, $val, @whatever) = @_;
- $self->called('around');
- $ori->($self, $val.'-diddly', @whatever);
- },
- after => sub {
- $_[0]->called('after');
- },
- },
- );
+ ::dies_ok {
+ has('bling' => (is => 'rw', trigger => []));
+ } '... a trigger must be a CODE ref';
}
-sub fancy_trigger_tests
+# Triggers do not fire on built values
+
{
- my $type = shift;
- my $blah;
- ::lives_ok {
- $blah = Fweet->new;
- } "... $type constructor";
- my $expected_calls = [qw(before around after)];
-
- is_deeply($blah->calls, $expected_calls, "$type default triggered");
- is($blah->noise, 'Sartak-diddly', "$type default around modified value");
- @{$blah->calls} = ();
-
- $blah->noise('argle-bargle');
- is_deeply($blah->calls, $expected_calls, "$type set triggered");
- is($blah->noise, 'argle-bargle-diddly', "$type set around modified value");
-
- $blah = Fweet->new(noise => 'woot');
- is_deeply($blah->calls, $expected_calls, "$type constructor triggered");
- is($blah->noise, 'woot-diddly', "$type constructor around modified value");
+ package Blarg;
+ use Moose;
+
+ our %trigger_calls;
+ our %trigger_vals;
+ has foo => (is => 'rw', default => sub { 'default foo value' },
+ trigger => sub { my ($self, $val, $attr) = @_;
+ $trigger_calls{foo}++;
+ $trigger_vals{foo} = $val });
+ has bar => (is => 'rw', lazy_build => 1,
+ trigger => sub { my ($self, $val, $attr) = @_;
+ $trigger_calls{bar}++;
+ $trigger_vals{bar} = $val });
+ sub _build_bar { return 'default bar value' }
+ has baz => (is => 'rw', builder => '_build_baz',
+ trigger => sub { my ($self, $val, $attr) = @_;
+ $trigger_calls{baz}++;
+ $trigger_vals{baz} = $val });
+ sub _build_baz { return 'default baz value' }
}
{
- fancy_trigger_tests('normal');
- ::lives_ok {
- Fweet->meta->make_immutable;
- } '... make_immutable works';
- fancy_trigger_tests('inline');
+ my $blarg;
+ lives_ok { $blarg = Blarg->new; } 'Blarg->new() lives';
+ ok($blarg, 'Have a $blarg');
+ foreach my $attr (qw/foo bar baz/) {
+ is($blarg->$attr(), "default $attr value", "$attr has default value");
+ }
+ is_deeply(\%Blarg::trigger_calls, {}, 'No triggers fired');
+ foreach my $attr (qw/foo bar baz/) {
+ $blarg->$attr("Different $attr value");
+ }
+ is_deeply(\%Blarg::trigger_calls, { map { $_ => 1 } qw/foo bar baz/ }, 'All triggers fired once on assign');
+ is_deeply(\%Blarg::trigger_vals, { map { $_ => "Different $_ value" } qw/foo bar baz/ }, 'All triggers given assigned values');
+
+ lives_ok { $blarg => Blarg->new( map { $_ => "Yet another $_ value" } qw/foo bar baz/ ) } '->new() with parameters';
+ is_deeply(\%Blarg::trigger_calls, { map { $_ => 2 } qw/foo bar baz/ }, 'All triggers fired once on construct');
+ is_deeply(\%Blarg::trigger_vals, { map { $_ => "Yet another $_ value" } qw/foo bar baz/ }, 'All triggers given assigned values');
}
-# some errors
+# Triggers do not receive the meta-attribute as an argument
{
- package Bling;
+ package Foo;
use Moose;
+ our @calls;
+ has foo => (is => 'rw', trigger => sub { push @calls, [@_] });
+}
- ::dies_ok {
- has('bling' => (is => 'rw', trigger => {FAIL => sub {}}));
- } '... hash specifier has to be before/around/after';
+{
+ my $attr = Foo->meta->get_attribute('foo');
+ my $foo = Foo->new(foo => 2);
+ is_deeply(
+ \@Foo::calls,
+ [ [ $foo, 2 ] ],
+ 'trigger called correctly on construction',
+ );
+ @Foo::calls = ();
- ::dies_ok {
- has('bling' => (is => 'rw', trigger => {around => 'FAIL'}));
- } '... hash specifier value must be CODE ref';
-
- ::dies_ok {
- has('bling' => (is => 'rw', trigger => 'Fail'));
- } '... a trigger must be a CODE or HASH ref';
-
- ::dies_ok {
- has('bling' => (is => 'rw', trigger => []));
- } '... a trigger must be a CODE or HASH ref';
+ $foo->foo(3);
+ is_deeply(
+ \@Foo::calls,
+ [ [ $foo, 3 ] ],
+ 'trigger called correctly on set',
+ );
+ @Foo::calls = ();
+ Foo->meta->make_immutable, redo if Foo->meta->is_mutable;
}