1use strict;
2use warnings;
3
4use Test::More;
5use Test::Fatal;
6
7use Class::MOP;
8use Class::MOP::Method;
9
10# test before and afters
11{
12    my $trace = '';
13
14    my $method = Class::MOP::Method->wrap(
15        body => sub { $trace .= 'primary' },
16        package_name => 'main',
17        name         => '__ANON__',
18    );
19    isa_ok( $method, 'Class::MOP::Method' );
20
21    $method->();
22    is( $trace, 'primary', '... got the right return value from method' );
23    $trace = '';
24
25    my $wrapped = Class::MOP::Method::Wrapped->wrap($method);
26    isa_ok( $wrapped, 'Class::MOP::Method::Wrapped' );
27    isa_ok( $wrapped, 'Class::MOP::Method' );
28
29    $wrapped->();
30    is( $trace, 'primary',
31        '... got the right return value from the wrapped method' );
32    $trace = '';
33
34    is( exception {
35        $wrapped->add_before_modifier( sub { $trace .= 'before -> ' } );
36    }, undef, '... added the before modifier okay' );
37
38    $wrapped->();
39    is( $trace, 'before -> primary',
40        '... got the right return value from the wrapped method (w/ before)'
41    );
42    $trace = '';
43
44    is( exception {
45        $wrapped->add_after_modifier( sub { $trace .= ' -> after' } );
46    }, undef, '... added the after modifier okay' );
47
48    $wrapped->();
49    is( $trace, 'before -> primary -> after',
50        '... got the right return value from the wrapped method (w/ before)'
51    );
52    $trace = '';
53}
54
55# test around method
56{
57    my $method = Class::MOP::Method->wrap(
58        sub {4},
59        package_name => 'main',
60        name         => '__ANON__',
61    );
62    isa_ok( $method, 'Class::MOP::Method' );
63
64    is( $method->(), 4, '... got the right value from the wrapped method' );
65
66    my $wrapped = Class::MOP::Method::Wrapped->wrap($method);
67    isa_ok( $wrapped, 'Class::MOP::Method::Wrapped' );
68    isa_ok( $wrapped, 'Class::MOP::Method' );
69
70    is( $wrapped->(), 4, '... got the right value from the wrapped method' );
71
72    is( exception {
73        $wrapped->add_around_modifier( sub { ( 3, $_[0]->() ) } );
74        $wrapped->add_around_modifier( sub { ( 2, $_[0]->() ) } );
75        $wrapped->add_around_modifier( sub { ( 1, $_[0]->() ) } );
76        $wrapped->add_around_modifier( sub { ( 0, $_[0]->() ) } );
77    }, undef, '... added the around modifier okay' );
78
79    is_deeply(
80        [ $wrapped->() ],
81        [ 0, 1, 2, 3, 4 ],
82        '... got the right results back from the around methods (in list context)'
83    );
84
85    is( scalar $wrapped->(), 4,
86        '... got the right results back from the around methods (in scalar context)'
87    );
88}
89
90{
91    my @tracelog;
92
93    my $method = Class::MOP::Method->wrap(
94        sub { push @tracelog => 'primary' },
95        package_name => 'main',
96        name         => '__ANON__',
97    );
98    isa_ok( $method, 'Class::MOP::Method' );
99
100    my $wrapped = Class::MOP::Method::Wrapped->wrap($method);
101    isa_ok( $wrapped, 'Class::MOP::Method::Wrapped' );
102    isa_ok( $wrapped, 'Class::MOP::Method' );
103
104    is( exception {
105        $wrapped->add_before_modifier( sub { push @tracelog => 'before 1' } );
106        $wrapped->add_before_modifier( sub { push @tracelog => 'before 2' } );
107        $wrapped->add_before_modifier( sub { push @tracelog => 'before 3' } );
108    }, undef, '... added the before modifier okay' );
109
110    is( exception {
111        $wrapped->add_around_modifier(
112            sub { push @tracelog => 'around 1'; $_[0]->(); } );
113        $wrapped->add_around_modifier(
114            sub { push @tracelog => 'around 2'; $_[0]->(); } );
115        $wrapped->add_around_modifier(
116            sub { push @tracelog => 'around 3'; $_[0]->(); } );
117    }, undef, '... added the around modifier okay' );
118
119    is( exception {
120        $wrapped->add_after_modifier( sub { push @tracelog => 'after 1' } );
121        $wrapped->add_after_modifier( sub { push @tracelog => 'after 2' } );
122        $wrapped->add_after_modifier( sub { push @tracelog => 'after 3' } );
123    }, undef, '... added the after modifier okay' );
124
125    $wrapped->();
126    is_deeply(
127        \@tracelog,
128        [
129            'before 3', 'before 2', 'before 1',    # last-in-first-out order
130            'around 3', 'around 2', 'around 1',    # last-in-first-out order
131            'primary',
132            'after 1', 'after 2', 'after 3',       # first-in-first-out order
133        ],
134        '... got the right tracelog from all our before/around/after methods'
135    );
136}
137
138# test introspection
139{
140    sub before1 {
141    }
142
143    sub before2 {
144    }
145
146    sub before3 {
147    }
148
149    sub after1 {
150    }
151
152    sub after2 {
153    }
154
155    sub after3 {
156    }
157
158    sub around1 {
159    }
160
161    sub around2 {
162    }
163
164    sub around3 {
165    }
166
167    sub orig {
168    }
169
170    my $method = Class::MOP::Method->wrap(
171        body         => \&orig,
172        package_name => 'main',
173        name         => '__ANON__',
174    );
175
176    my $wrapped = Class::MOP::Method::Wrapped->wrap($method);
177
178    $wrapped->add_before_modifier($_)
179        for \&before1, \&before2, \&before3;
180
181    $wrapped->add_after_modifier($_)
182        for \&after1, \&after2, \&after3;
183
184    $wrapped->add_around_modifier($_)
185        for \&around1, \&around2, \&around3;
186
187    is( $wrapped->get_original_method, $method,
188        'check get_original_method' );
189
190    is_deeply( [ $wrapped->before_modifiers ],
191               [ \&before3, \&before2, \&before1 ],
192               'check before_modifiers' );
193
194    is_deeply( [ $wrapped->after_modifiers ],
195               [ \&after1, \&after2, \&after3 ],
196               'check after_modifiers' );
197
198    is_deeply( [ $wrapped->around_modifiers ],
199               [ \&around3, \&around2, \&around1 ],
200               'check around_modifiers' );
201}
202
203# test stringification of modifiers
204{
205    package Parent;
206    use Moose;
207
208    sub something {
209    }
210}
211{
212    package Child;
213    use Moose;
214    extends 'Parent';
215
216    after 'something' => sub {
217        confess 'boom';
218    };
219}
220{
221    my @errors;
222    local $SIG{__DIE__} = sub { push @errors, @_ };
223    eval { Child->new->something() };
224    my $msg = join "\n", @errors;
225    ::like($msg, qr/^boom at /, 'correct exception');
226    ::like($msg, qr/:::after/, 'stacktrace contains :after');
227    ::like($msg, qr/Child::_wrapped_something/, 'stacktrace contains wrapped method name');
228    ::unlike($msg, qr/__ANON__/, 'stacktrace does not contain __ANON__');
229    ::note($msg);
230}
231
232done_testing;
233