Commit | Line | Data |
c3398f5b |
1 | #!/usr/bin/env perl |
2 | use strict; |
3 | use warnings; |
8ab2c6ab |
4 | use Test::More; |
eab81545 |
5 | use Test::Exception; |
c3398f5b |
6 | |
7 | my @trigger; |
8 | |
9 | do { |
10 | package Class; |
11 | use Mouse; |
12 | |
13 | has attr => ( |
14 | is => 'rw', |
15 | default => 10, |
16 | trigger => sub { |
25431bc4 |
17 | my ($self, $value) = @_; |
18 | push @trigger, [$self, $value]; |
c3398f5b |
19 | }, |
20 | ); |
21 | |
8ab2c6ab |
22 | has foobar => ( # from Net::Google::DataAPI |
23 | is => 'rw', |
24 | isa => 'Str', |
25 | |
26 | lazy => 1, |
27 | trigger => sub{ $_[0]->update }, |
28 | default => sub{ 'piyo' }, |
29 | |
30 | clearer => 'clear_foobar', |
31 | ); |
32 | |
33 | sub update { |
34 | my($self) = @_; |
35 | $self->clear_foobar; |
36 | } |
37 | |
84731080 |
38 | ::lives_ok { |
6c5498d0 |
39 | has not_error => ( |
c3398f5b |
40 | is => 'ro', |
41 | trigger => sub { }, |
42 | ); |
84731080 |
43 | } "it's no longer an error to have trigger on a readonly attribute"; |
6c5498d0 |
44 | |
45 | ::throws_ok { |
46 | has error => ( |
47 | is => 'ro', |
48 | trigger => [], |
49 | ); |
844fa049 |
50 | } qr/Trigger must be a CODE ref on attribute \(error\)/; |
c3398f5b |
51 | }; |
52 | |
53 | can_ok(Class => 'attr'); |
54 | |
55 | my $object = Class->new; |
56 | is(@trigger, 0, "trigger not called yet"); |
57 | |
58 | is($object->attr, 10, "default value"); |
59 | is(@trigger, 0, "trigger not called on read"); |
60 | |
61 | is($object->attr(50), 50, "setting the value"); |
62 | is(@trigger, 1, "trigger was called on read"); |
25431bc4 |
63 | is_deeply([splice @trigger], [[$object, 50]], "correct arguments to trigger in the accessor"); |
c3398f5b |
64 | |
8ab2c6ab |
65 | is($object->foobar, 'piyo'); |
25431bc4 |
66 | lives_ok { $object->foobar('baz') } "triggers that clear the attr"; |
67 | |
8ab2c6ab |
68 | is($object->foobar, 'piyo', "call clearer in triggers"); |
69 | |
c3398f5b |
70 | my $object2 = Class->new(attr => 100); |
71 | is(@trigger, 1, "trigger was called on new with the attribute specified"); |
25431bc4 |
72 | is_deeply([splice @trigger], [[$object2, 100]], "correct arguments to trigger in the constructor"); |
c3398f5b |
73 | |
8ab2c6ab |
74 | done_testing; |