Commit | Line | Data |
38bf2a25 |
1 | use strict; |
2 | use warnings; |
3 | |
4 | use Test::More; |
5 | use Test::Fatal; |
6 | |
7 | use Class::MOP; |
8 | |
9 | my @calls; |
10 | |
11 | { |
12 | package Parent; |
13 | |
14 | use strict; |
15 | use warnings; |
16 | use metaclass; |
17 | |
18 | use Carp 'confess'; |
19 | |
20 | sub method { push @calls, 'Parent::method' } |
21 | |
22 | package Child; |
23 | |
24 | use strict; |
25 | use warnings; |
26 | use metaclass; |
27 | |
28 | use base 'Parent'; |
29 | |
30 | Child->meta->add_around_method_modifier( |
31 | 'method' => sub { |
32 | my $orig = shift; |
33 | push @calls, 'before Child::method'; |
34 | $orig->(@_); |
35 | push @calls, 'after Child::method'; |
36 | } |
37 | ); |
38 | } |
39 | |
40 | Parent->method; |
41 | |
42 | is_deeply( |
43 | [ splice @calls ], |
44 | [ |
45 | 'Parent::method', |
46 | ] |
47 | ); |
48 | |
49 | Child->method; |
50 | |
51 | is_deeply( |
52 | [ splice @calls ], |
53 | [ |
54 | 'before Child::method', |
55 | 'Parent::method', |
56 | 'after Child::method', |
57 | ] |
58 | ); |
59 | |
60 | { |
61 | package Parent; |
62 | |
63 | Parent->meta->add_around_method_modifier( |
64 | 'method' => sub { |
65 | my $orig = shift; |
66 | push @calls, 'before Parent::method'; |
67 | $orig->(@_); |
68 | push @calls, 'after Parent::method'; |
69 | } |
70 | ); |
71 | } |
72 | |
73 | Parent->method; |
74 | |
75 | is_deeply( |
76 | [ splice @calls ], |
77 | [ |
78 | 'before Parent::method', |
79 | 'Parent::method', |
80 | 'after Parent::method', |
81 | ] |
82 | ); |
83 | |
84 | Child->method; |
85 | |
86 | TODO: { |
87 | local $TODO = "pending fix"; |
88 | is_deeply( |
89 | [ splice @calls ], |
90 | [ |
91 | 'before Child::method', |
92 | 'before Parent::method', |
93 | 'Parent::method', |
94 | 'after Parent::method', |
95 | 'after Child::method', |
96 | ], |
97 | "cache is correctly invalidated when the parent method is wrapped" |
98 | ); |
99 | } |
100 | |
101 | done_testing; |