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
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
|
#!/usr/bin/perl
use strict;
BEGIN {
$| = 1;
$^W = 1;
}
use Test::More tests => 35;
use Test::NoWarnings;
use Aspect;
my $good = 'SomePackage::some_method';
my $bad = 'SomePackage::no_method';
pointcut_ok( string => 'SomePackage::some_method' );
pointcut_ok( re => qr/some_method/ );
pointcut_ok( code => sub { shift eq $good } );
sub pointcut_ok {
my $type = shift;
my $subject = Aspect::Pointcut::Call->new(shift);
# Do we get a compiled match function?
my $compiled1 = $subject->compiled_weave;
is( ref($compiled1), 'CODE', '->compiled_weave returns a CODE reference' );
# Does it match the expected functions?
my $good_matches = do { local $_ = $good; $compiled1->() };
my $bad_matches = do { local $_ = $bad; $compiled1->() };
ok( $good_matches, "$type match" );
ok( ! $bad_matches, "$type no match" );
# Does it curry away to nothing?
my $curried = $subject->curry_runtime;
is( $curried, undef, 'Simple call curries away to nothing' );
# Do we produce an appropriate compiled run-time function
my $compiled2 = $subject->compiled_runtime;
is( ref($compiled2), 'CODE', '->compiled_runtime returns a CODE reference' );
# Does the compiled code work properly?
my $good_match = do {
local $Aspect::POINT = { sub_name => $good };
$compiled2->();
};
my $bad_match = do {
local $Aspect::POINT = { sub_name => $bad };
$compiled2->();
};
ok( $good_match, "$type match" );
ok( ! $bad_match, "$type no match" );
}
######################################################################
# Overloading Tests
# Pointcut currying code will need to do boolean context checks on
# pointcuts, as will some user code.
# Validate we can actually be used in boolean context (and provide an
# entry point to examine where this overloads to in the debugger).
my $pointcut = call 'Foo::bar';
isa_ok( $pointcut, 'Aspect::Pointcut::Call' );
ok( $pointcut, 'Pointcut is usable in boolean context' );
# Test that negation creates a not pointcut
isa_ok( ! $pointcut, 'Aspect::Pointcut::Not' );
######################################################################
# Regression: Validate that the "not call and call" pattern works.
# The following package has two methods.
# A pointcut that defines "Not one and any method" should match two but
# not match one. And this rule should apply BOTH to the match_all
# define-time rule AND for the runtime rule.
SCOPE: {
package One;
sub one { }
sub two { }
}
my $not_call_and_call = ! call('One::one') & call(qr/^One::/);
isa_ok( $not_call_and_call, 'Aspect::Pointcut::And' );
# Does match_all find only the second method?
is_deeply(
[ $not_call_and_call->match_all ],
[ 'One::two' ],
'->match_all works as expected',
);
# Create the runtime-curried pointcut
my $curried = $not_call_and_call->curry_runtime;
is( $curried, undef, 'A call-only pointcut curries away to nothing' );
######################################################################
# Regression: Nested logic and nested call and run-time
# Combining nested logic with a mix of call and non-call pointcuts
# results in a situation where call pointcuts need to be retained
# at run-time so that we can limit calls to run-time pointcuts to the
# correct subset of cases to apply the run-time tests to.
SCOPE: {
package Two;
sub one { 1 }
sub two { 2 }
}
my $complex = call qr/^Two::/ & (
call qr/::one\z/
| (
wantscalar & call qr/::two\z/
)
);
isa_ok( $complex, 'Aspect::Pointcut' );
ok(
scalar $complex->match_contains('Aspect::Pointcut::Wantarray'),
'Pointcut contains the Wantarray pointcut',
);
# We should match_all both functions
is_deeply(
[ sort $complex->match_all ], #sort for new hash randomization
[ 'Two::one', 'Two::two' ],
'->match_all works as expected',
);
# Bind the aspect
before {
$_[0]->return_value(0);
} $complex;
# Both functions should match in scalar context
is( scalar(Two::one()), 0, 'Scalar one matches' );
is( scalar(Two::two()), 0, 'Scalar two matches' );
# Only one should match in list context
is_deeply( [ Two::one() ], [ 0 ], 'List one matches' );
is_deeply( [ Two::two() ], [ 2 ], 'List two does not match' );
|
