1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
|
# taken from Class::MOP's test suite, cut down to the interesting bits I haven't
# necessarily tested yet
use strict;
use warnings;
use Test::More 0.88;
use if $ENV{AUTHOR_TESTING}, 'Test::Warnings';
my @tracelog;
package GreatGrandMyParent;
sub new { bless {}, shift }
sub method { 4 }
sub wrapped { push @tracelog => 'primary' }
package GrandMyParent;
use Class::Method::Modifiers;
our @ISA = 'GreatGrandMyParent';
around method => sub { (3, $_[0]->()) };
package MyParent;
use Class::Method::Modifiers;
our @ISA = 'GrandMyParent';
around method => sub { (2, $_[0]->()) };
package Child;
use Class::Method::Modifiers;
our @ISA = 'MyParent';
around method => sub { (1, $_[0]->()) };
package GrandChild;
use Class::Method::Modifiers;
our @ISA = 'Child';
around method => sub { (0, $_[0]->()) };
before wrapped => sub { push @tracelog => 'before 1' };
before wrapped => sub { push @tracelog => 'before 2' };
before wrapped => sub { push @tracelog => 'before 3' };
around wrapped => sub { push @tracelog => 'around 1'; $_[0]->() };
around wrapped => sub { push @tracelog => 'around 2'; $_[0]->() };
around wrapped => sub { push @tracelog => 'around 3'; $_[0]->() };
after wrapped => sub { push @tracelog => 'after 1' };
after wrapped => sub { push @tracelog => 'after 2' };
after wrapped => sub { push @tracelog => 'after 3' };
package main;
my $gc = GrandChild->new();
is_deeply(
[ $gc->method() ],
[ 0, 1, 2, 3, 4 ],
'... got the right results back from the around methods (in list context)');
is(scalar $gc->method(), 4, '... got the right results back from the around methods (in scalar context)');
$gc->wrapped();
is_deeply(
\@tracelog,
[
'before 3', 'before 2', 'before 1', # last-in-first-out order
'around 3', 'around 2', 'around 1', # last-in-first-out order
'primary',
'after 1', 'after 2', 'after 3', # first-in-first-out order
],
'... got the right tracelog from all our before/around/after methods');
done_testing;
|
