5 use Test::More tests => 25;
8 my @expected = ("before 4",
27 my $child = Grandchild->new; $child->orig;
29 is_deeply(\@seen, \@expected, "multiple afters called in the right order");
46 push @seen, "before 1";
50 push @seen, "before 2";
55 push @seen, "around 1 before";
57 push @seen, "around 1 after";
62 push @seen, "around 2 before";
64 push @seen, "around 2 after";
68 push @seen, "after 1";
72 push @seen, "after 2";
82 push @seen, "before 3";
86 push @seen, "before 4";
91 push @seen, "around 3 before";
93 push @seen, "around 3 after";
98 push @seen, "around 4 before";
100 push @seen, "around 4 after";
104 push @seen, "after 3";
108 push @seen, "after 4";
112 # from Class::Method::Modifers' t/020-multiple-inheritance.t
114 # inheritance tree looks like:
122 # the Child and MiddleR modules use modifiers
123 # Child will modify a method in SuperL (sl_c)
124 # Child will modify a method in SuperR (sr_c)
125 # Child will modify a method in SuperR already modified by MiddleR (sr_m_c)
126 # SuperL and MiddleR will both have a method of the same name, doing different
127 # things (called 'conflict' and 'cnf_mod')
129 # every method and modifier will just return <Class:Method:STUFF>
137 sub superl { "<SuperL:superl>" }
138 sub conflict { "<SuperL:conflict>" }
139 sub cnf_mod { "<SuperL:cnf_mod>" }
140 sub sl_c { "<SuperL:sl_c>" }
147 sub superr { "<SuperR:superr>" }
148 sub sr_c { "<SuperR:sr_c>" }
149 sub sr_m_c { "<SuperR:sr_m_c>" }
157 sub middlel { "<MiddleL:middlel>" }
165 sub middler { "<MiddleR:middler>" }
166 sub conflict { "<MiddleR:conflict>" }
167 sub cnf_mod { "<MiddleR:cnf_mod>" }
168 around sr_m_c => sub {
170 return "<MiddleR:sr_m_c:".$orig->(@_).">"
177 extends qw(MiddleL MiddleR);
179 sub child { "<Child:child>" }
180 around cnf_mod => sub { "<Child:cnf_mod:".shift->(@_).">" };
181 around sl_c => sub { "<Child:sl_c:".shift->(@_).">" };
182 around sr_c => sub { "<Child:sr_c:".shift->(@_).">" };
183 around sr_m_c => sub {
185 return "<Child:sr_m_c:".$orig->(@_).">"
191 my $SuperL = SuperL->new();
192 my $SuperR = SuperR->new();
193 my $MiddleL = MiddleL->new();
194 my $MiddleR = MiddleR->new();
195 my $Child = Child->new();
197 is($SuperL->superl, "<SuperL:superl>", "SuperL loaded correctly");
198 is($SuperR->superr, "<SuperR:superr>", "SuperR loaded correctly");
199 is($MiddleL->middlel, "<MiddleL:middlel>", "MiddleL loaded correctly");
200 is($MiddleR->middler, "<MiddleR:middler>", "MiddleR loaded correctly");
201 is($Child->child, "<Child:child>", "Child loaded correctly");
203 is($SuperL->sl_c, "<SuperL:sl_c>", "SuperL->sl_c on SuperL");
204 is($Child->sl_c, "<Child:sl_c:<SuperL:sl_c>>", "SuperL->sl_c wrapped by Child's around");
206 is($SuperR->sr_c, "<SuperR:sr_c>", "SuperR->sr_c on SuperR");
207 is($Child->sr_c, "<Child:sr_c:<SuperR:sr_c>>", "SuperR->sr_c wrapped by Child's around");
209 is($SuperR->sr_m_c, "<SuperR:sr_m_c>", "SuperR->sr_m_c on SuperR");
210 is($MiddleR->sr_m_c, "<MiddleR:sr_m_c:<SuperR:sr_m_c>>", "SuperR->sr_m_c wrapped by MiddleR's around");
211 is($Child->sr_m_c, "<Child:sr_m_c:<MiddleR:sr_m_c:<SuperR:sr_m_c>>>", "MiddleR->sr_m_c's wrapping wrapped by Child's around");
213 is($SuperL->conflict, "<SuperL:conflict>", "SuperL->conflict on SuperL");
214 is($MiddleR->conflict, "<MiddleR:conflict>", "MiddleR->conflict on MiddleR");
215 is($Child->conflict, "<SuperL:conflict>", "SuperL->conflict on Child");
217 is($SuperL->cnf_mod, "<SuperL:cnf_mod>", "SuperL->cnf_mod on SuperL");
218 is($MiddleR->cnf_mod, "<MiddleR:cnf_mod>", "MiddleR->cnf_mod on MiddleR");
219 is($Child->cnf_mod, "<Child:cnf_mod:<SuperL:cnf_mod>>", "SuperL->cnf_mod wrapped by Child's around");
221 # taken from Class::Method::Modifiers' t/051-undef-list-ctxt.t
222 my($orig_called, $after_called);
246 ($after_called, $orig_called) = (0, 0);
247 my $child = ChildX->new();
248 my @results = $child->orig();
250 ok($orig_called, "original method called");
251 ok($after_called, "after-modifier called");
252 is(@results, 0, "list context with after doesn't screw up 'return'");
254 ($after_called, $orig_called) = (0, 0);
255 my $result = $child->orig();
257 ok($orig_called, "original method called");
258 ok($after_called, "after-modifier called");
259 is($result, undef, "scalar context with after doesn't screw up 'return'");