Move t/*/t into t/001_mouse

[gitmo/Mouse.git] / t / 001_mouse / 016-trigger.t

diff --git a/t/001_mouse/016-trigger.t b/t/001_mouse/016-trigger.t
new file mode 100644 (file)
index 0000000..2f3a666
--- /dev/null
+++ b/t/001_mouse/016-trigger.t
@@ -0,0 +1,52 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use Test::More tests => 11;
+use Test::Exception;
+
+my @trigger;
+
+do {
+    package Class;
+    use Mouse;
+
+    has attr => (
+        is => 'rw',
+        default => 10,
+        trigger => sub {
+            my ($self, $value, $attr) = @_;
+            push @trigger, [$self, $value, $attr];
+        },
+    );
+
+    ::lives_ok {
+        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');
+
+my $object = Class->new;
+is(@trigger, 0, "trigger not called yet");
+
+is($object->attr, 10, "default value");
+is(@trigger, 0, "trigger not called on read");
+
+is($object->attr(50), 50, "setting the value");
+is(@trigger, 1, "trigger was called on read");
+is_deeply([splice @trigger], [[$object, 50, undef]], "correct arguments to trigger in the accessor");
+
+my $object2 = Class->new(attr => 100);
+is(@trigger, 1, "trigger was called on new with the attribute specified");
+is_deeply([splice @trigger], [[$object2, 100, undef]], "correct arguments to trigger in the constructor");
+