Name for Mouse::Role
[gitmo/Mouse.git] / t / 016-trigger.t
CommitLineData
c3398f5b 1#!/usr/bin/env perl
2use strict;
3use warnings;
a08e715f 4use Test::More tests => 11;
eab81545 5use Test::Exception;
c3398f5b 6
7my @trigger;
8
9do {
10 package Class;
11 use Mouse;
12
13 has attr => (
14 is => 'rw',
15 default => 10,
16 trigger => sub {
17 my ($self, $value, $attr) = @_;
18 push @trigger, [$self, $value, $attr];
19 },
20 );
21
84731080 22 ::lives_ok {
6c5498d0 23 has not_error => (
c3398f5b 24 is => 'ro',
25 trigger => sub { },
26 );
84731080 27 } "it's no longer an error to have trigger on a readonly attribute";
6c5498d0 28
29 ::throws_ok {
30 has error => (
31 is => 'ro',
32 trigger => [],
33 );
844fa049 34 } qr/Trigger must be a CODE ref on attribute \(error\)/;
c3398f5b 35};
36
37can_ok(Class => 'attr');
38
39my $object = Class->new;
40is(@trigger, 0, "trigger not called yet");
41
42is($object->attr, 10, "default value");
43is(@trigger, 0, "trigger not called on read");
44
45is($object->attr(50), 50, "setting the value");
46is(@trigger, 1, "trigger was called on read");
c0085d11 47is_deeply([splice @trigger], [[$object, 50, $object->meta->get_attribute('attr')]], "correct arguments to trigger in the accessor");
c3398f5b 48
49my $object2 = Class->new(attr => 100);
50is(@trigger, 1, "trigger was called on new with the attribute specified");
c0085d11 51is_deeply([splice @trigger], [[$object2, 100, $object2->meta->get_attribute('attr')]], "correct arguments to trigger in the constructor");
c3398f5b 52