X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2F020_attributes%2F004_attribute_triggers.t;h=803cc63ec5ec9b363c3d8b19eb22091a5998f150;hb=be0ed15704fdad5f2d8517380a6f24687432c1dd;hp=637d604e05d34d9c75f0f54c56c56a7ad9733801;hpb=010997ca7f90b5313e23aa7bbdd6535c7ab265cc;p=gitmo%2FMoose.git

diff --git a/t/020_attributes/004_attribute_triggers.t b/t/020_attributes/004_attribute_triggers.t
index 637d604..803cc63 100644
--- a/t/020_attributes/004_attribute_triggers.t
+++ b/t/020_attributes/004_attribute_triggers.t
@@ -5,40 +5,39 @@ use warnings;
 
 use Scalar::Util 'isweak';
 
-use Test::More tests => 36;
-use Test::Exception;
-
+use Test::More;
+use Test::Fatal;
 
 
 {
     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);
 }
 
 {
@@ -51,27 +50,27 @@ use Test::Exception;
     my $baz = Baz->new;
     isa_ok($baz, 'Baz');
 
-    lives_ok {
+    ok ! exception {
         $foo->bar($bar);
-    } '... did not die setting bar';
+    }, '... did not die setting bar';
 
     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($bar->{foo}), '... bar.foo is a weak reference');
-    
-    lives_ok {
+
+    ok ! exception {
         $foo->bar(undef);
-    } '... did not die un-setting bar';
+    }, '... 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
 
-    lives_ok {
+    ok ! exception {
         $foo->set_baz($baz);
-    } '... did not die setting baz';
+    }, '... did not die setting baz';
 
     is($foo->get_baz, $baz, '... set the value foo.baz correctly');
     is($baz->foo, $foo, '... which in turn set the value baz.foo correctly');
@@ -85,9 +84,9 @@ use Test::Exception;
 
     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');
@@ -105,14 +104,14 @@ use Test::Exception;
 {
     package Bling;
     use Moose;
-    
-    ::dies_ok { 
+
+    ::ok ::exception {
         has('bling' => (is => 'rw', trigger => 'Fail'));
-    } '... a trigger must be a CODE ref';
-    
-    ::dies_ok { 
+    }, '... a trigger must be a CODE ref';
+
+    ::ok ::exception {
         has('bling' => (is => 'rw', trigger => []));
-    } '... a trigger must be a CODE ref';    
+    }, '... a trigger must be a CODE ref';
 }
 
 # Triggers do not fire on built values
@@ -141,7 +140,7 @@ use Test::Exception;
 
 {
     my $blarg;
-    lives_ok { $blarg = Blarg->new; } 'Blarg->new() lives';
+    ok ! exception { $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");
@@ -153,8 +152,70 @@ use Test::Exception;
     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';
+    ok ! exception { $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');
 }
 
+# Triggers do not receive the meta-attribute as an argument, but do
+# receive the old value
+
+{
+    package Foo;
+    use Moose;
+    our @calls;
+    has foo => (is => 'rw', trigger => sub { push @calls, [@_] });
+}
+
+{
+    my $attr = Foo->meta->get_attribute('foo');
+
+    my $foo = Foo->new;
+    $attr->set_value( $foo, 2 );
+
+    is_deeply(
+        \@Foo::calls,
+        [ [ $foo, 2 ] ],
+        'trigger called correctly on initial set via meta-API',
+    );
+    @Foo::calls = ();
+
+    $attr->set_value( $foo, 3 );
+
+    is_deeply(
+        \@Foo::calls,
+        [ [ $foo, 3, 2 ] ],
+        'trigger called correctly on second set via meta-API',
+    );
+    @Foo::calls = ();
+
+    $attr->set_raw_value( $foo, 4 );
+
+    is_deeply(
+        \@Foo::calls,
+        [ ],
+        'trigger not called using set_raw_value method',
+    );
+    @Foo::calls = ();
+}
+
+{
+    my $foo = Foo->new(foo => 2);
+    is_deeply(
+        \@Foo::calls,
+        [ [ $foo, 2 ] ],
+        'trigger called correctly on construction',
+    );
+    @Foo::calls = ();
+
+    $foo->foo(3);
+    is_deeply(
+        \@Foo::calls,
+        [ [ $foo, 3, 2 ] ],
+        'trigger called correctly on set (with old value)',
+    );
+    @Foo::calls = ();
+    Foo->meta->make_immutable, redo if Foo->meta->is_mutable;
+}
+
+done_testing;