Fix which add-modifier method gets called
[gitmo/Mouse.git] / t / 016-trigger.t
index 2925a8e..312e9f2 100644 (file)
@@ -1,7 +1,7 @@
 #!/usr/bin/env perl
 use strict;
 use warnings;
-use Test::More tests => 10;
+use Test::More tests => 21;
 use Test::Exception;
 
 my @trigger;
@@ -20,11 +20,18 @@ do {
     );
 
     ::lives_ok {
-        has error => (
+        has not_error => (
             is => 'ro',
             trigger => sub { },
         );
     } "it's no longer an error to have trigger on a readonly attribute";
+
+    ::throws_ok {
+        has error => (
+            is => 'ro',
+            trigger => [],
+        );
+    } qr/Trigger must be a CODE ref on attribute \(error\)/;
 };
 
 can_ok(Class => 'attr');
@@ -43,3 +50,69 @@ my $object2 = Class->new(attr => 100);
 is(@trigger, 1, "trigger was called on new with the attribute specified");
 is_deeply([splice @trigger], [[$object2, 100, $object2->meta->get_attribute('attr')]], "correct arguments to trigger in the constructor");
 
+do {
+    package Parent;
+    use Mouse;
+
+    has attr => (
+        is      => 'rw',
+        trigger => {
+            before => sub {
+                push @trigger, ['before', @_];
+            },
+            after => sub {
+                push @trigger, ['after', @_];
+            },
+            around => sub {
+                my $code = shift;
+                my ($self, $value, $attr) = @_;
+
+                push @trigger, ['around-before', $self, $value, $attr];
+                $code->($self, 4 * $value, $attr);
+                push @trigger, ['around-after', $self, $value, $attr];
+            },
+        },
+    );
+
+    package Child;
+    use Mouse;
+    extends 'Parent';
+
+    has '+attr' => (
+        default => 10,
+    );
+};
+
+my $child = Child->new;
+is(@trigger, 0, "trigger not called on constructor with default");
+
+is($child->attr, 10, "reader");
+is(@trigger, 0, "trigger not called on reader");
+
+is($child->attr(5), 20, "writer");
+is_deeply([splice @trigger], [
+    ['before',        $child,  5, Child->meta->get_attribute('attr')],
+    ['around-before', $child,  5, Child->meta->get_attribute('attr')],
+    ['around-after',  $child,  5, Child->meta->get_attribute('attr')],
+    ['after',         $child, 20, Child->meta->get_attribute('attr')],
+]);
+
+my $parent = Parent->new(attr => 2);
+is_deeply([splice @trigger], [
+    ['before',        $parent, 2, Parent->meta->get_attribute('attr')],
+    ['around-before', $parent, 2, Parent->meta->get_attribute('attr')],
+    ['around-after',  $parent, 2, Parent->meta->get_attribute('attr')],
+    ['after',         $parent, 8, Parent->meta->get_attribute('attr')],
+]);
+
+is($parent->attr, 8, "reader");
+is(@trigger, 0, "trigger not called on reader");
+
+is($parent->attr(10), 40, "writer");
+is_deeply([splice @trigger], [
+    ['before',        $parent, 10, Parent->meta->get_attribute('attr')],
+    ['around-before', $parent, 10, Parent->meta->get_attribute('attr')],
+    ['around-after',  $parent, 10, Parent->meta->get_attribute('attr')],
+    ['after',         $parent, 40, Parent->meta->get_attribute('attr')],
+]);
+