Commit | Line | Data |
c3398f5b |
1 | #!/usr/bin/env perl |
2 | use strict; |
3 | use warnings; |
2b091609 |
4 | use Test::More tests => 21; |
c3398f5b |
5 | use Test::Exception; |
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 { |
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 | |
37 | can_ok(Class => 'attr'); |
38 | |
39 | my $object = Class->new; |
40 | is(@trigger, 0, "trigger not called yet"); |
41 | |
42 | is($object->attr, 10, "default value"); |
43 | is(@trigger, 0, "trigger not called on read"); |
44 | |
45 | is($object->attr(50), 50, "setting the value"); |
46 | is(@trigger, 1, "trigger was called on read"); |
c0085d11 |
47 | is_deeply([splice @trigger], [[$object, 50, $object->meta->get_attribute('attr')]], "correct arguments to trigger in the accessor"); |
c3398f5b |
48 | |
49 | my $object2 = Class->new(attr => 100); |
50 | is(@trigger, 1, "trigger was called on new with the attribute specified"); |
c0085d11 |
51 | is_deeply([splice @trigger], [[$object2, 100, $object2->meta->get_attribute('attr')]], "correct arguments to trigger in the constructor"); |
c3398f5b |
52 | |
3b5febd3 |
53 | do { |
de231492 |
54 | package Parent; |
3b5febd3 |
55 | use Mouse; |
56 | |
57 | has attr => ( |
58 | is => 'rw', |
3b5febd3 |
59 | trigger => { |
60 | before => sub { |
61 | push @trigger, ['before', @_]; |
62 | }, |
63 | after => sub { |
64 | push @trigger, ['after', @_]; |
65 | }, |
66 | around => sub { |
67 | my $code = shift; |
cbdd0fa4 |
68 | my ($self, $value, $attr) = @_; |
69 | |
70 | push @trigger, ['around-before', $self, $value, $attr]; |
71 | $code->($self, 4 * $value, $attr); |
72 | push @trigger, ['around-after', $self, $value, $attr]; |
3b5febd3 |
73 | }, |
74 | }, |
75 | ); |
de231492 |
76 | |
77 | package Child; |
78 | use Mouse; |
79 | extends 'Parent'; |
80 | |
81 | has '+attr' => ( |
82 | default => 10, |
83 | ); |
3b5febd3 |
84 | }; |
85 | |
de231492 |
86 | my $child = Child->new; |
3b5febd3 |
87 | is(@trigger, 0, "trigger not called on constructor with default"); |
88 | |
de231492 |
89 | is($child->attr, 10, "reader"); |
3b5febd3 |
90 | is(@trigger, 0, "trigger not called on reader"); |
91 | |
de231492 |
92 | is($child->attr(5), 20, "writer"); |
3b5febd3 |
93 | is_deeply([splice @trigger], [ |
de231492 |
94 | ['before', $child, 5, Child->meta->get_attribute('attr')], |
95 | ['around-before', $child, 5, Child->meta->get_attribute('attr')], |
96 | ['around-after', $child, 5, Child->meta->get_attribute('attr')], |
97 | ['after', $child, 20, Child->meta->get_attribute('attr')], |
3b5febd3 |
98 | ]); |
99 | |
2b091609 |
100 | my $parent = Parent->new(attr => 2); |
101 | is_deeply([splice @trigger], [ |
102 | ['before', $parent, 2, Parent->meta->get_attribute('attr')], |
103 | ['around-before', $parent, 2, Parent->meta->get_attribute('attr')], |
104 | ['around-after', $parent, 2, Parent->meta->get_attribute('attr')], |
105 | ['after', $parent, 8, Parent->meta->get_attribute('attr')], |
106 | ]); |
107 | |
108 | is($parent->attr, 8, "reader"); |
109 | is(@trigger, 0, "trigger not called on reader"); |
110 | |
111 | is($parent->attr(10), 40, "writer"); |
112 | is_deeply([splice @trigger], [ |
113 | ['before', $parent, 10, Parent->meta->get_attribute('attr')], |
114 | ['around-before', $parent, 10, Parent->meta->get_attribute('attr')], |
115 | ['around-after', $parent, 10, Parent->meta->get_attribute('attr')], |
116 | ['after', $parent, 40, Parent->meta->get_attribute('attr')], |
117 | ]); |
118 | |