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
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
|
use strict;
use warnings;
sub trace {
my $trace = Test::Builder->new->trace_test;
return $trace;
}
BEGIN {
$INC{'XXX/Provider.pm'} = __FILE__;
$INC{'XXX/LegacyProvider.pm'} = __FILE__;
$INC{'XXX/Tester.pm'} = __FILE__;
}
# line 1000
{
package XXX::Provider;
use Test::Builder::Provider;
BEGIN {
provide explode => sub {
exploded();
};
}
sub exploded { overkill() }
sub overkill {
return main::trace();
}
sub nestit(&) {
my ($code) = @_;
nest{ $code->() };
return main::trace();
}
sub nonest(&) {
my ($code) = @_;
$code->();
return main::trace();
}
BEGIN {
provides qw/nestit/;
provides qw/nonest/;
}
}
# line 1500
{
package XXX::LegacyProvider;
use base 'Test::Builder::Module';
our @EXPORT;
BEGIN { @EXPORT = qw/do_it do_it_2 do_nestit do_nonest/ };
# line 1600
sub do_it {
my $builder = __PACKAGE__->builder;
my $trace = Test::Builder->new->trace_test;
return $trace;
}
# line 1700
sub do_it_2 {
local $Test::Builder::Level = $Test::Builder::Level + 1;
do_it(@_);
}
# line 1800
sub do_nestit(&) {
my ($code) = @_;
my $trace = Test::Builder->new->trace_test;
# TODO: I Think this is wrong...
local $Test::Builder::Level = $Test::Builder::Level + 3;
$code->();
return $trace;
}
}
# line 2000
package XXX::Tester;
use XXX::Provider;
use XXX::LegacyProvider;
use Test::Builder::Provider;
use Data::Dumper;
use Test::More;
provides 'explodable';
# line 2100
sub explodable { explode() };
# line 2200
sub explodadouble { explode() };
# line 2300
my $trace = explodable();
is($trace->report->line, 2300, "got correct line");
is($trace->report->package, 'XXX::Tester', "got correct package");
is_deeply(
$trace->report->provider_tool,
{package => 'XXX::Tester', name => 'explodable', named => 1},
"got tool info"
);
# line 2400
$trace = explodadouble();
is($trace->report->line, 2200, "got correct line");
is($trace->report->package, 'XXX::Tester', "got correct package");
is_deeply(
$trace->report->provider_tool,
{package => 'XXX::Provider', name => 'explode', named => 0},
"got tool info"
);
# line 2500
$trace = explode();
is($trace->report->line, 2500, "got correct line");
is($trace->report->package, 'XXX::Tester', "got correct package");
is_deeply(
$trace->report->provider_tool,
{package => 'XXX::Provider', name => 'explode', named => 0},
"got tool info"
);
# line 2600
$trace = do_it();
is($trace->report->line, 2600, "got correct line");
is($trace->report->package, 'XXX::Tester', "got correct package");
ok(!$trace->report->provider_tool, "No Tool");
# line 2700
$trace = do_it_2();
is($trace->report->line, 2700, "got correct line");
is($trace->report->package, 'XXX::Tester', "got correct package");
is($trace->report->level, 1, "Is level");
ok(!$trace->report->provider_tool, "No Tool");
my @events;
# Here we simulate subtests
# line 2800
$trace = nestit {
push @events => explodable();
push @events => explodadouble();
push @events => explode();
push @events => do_it();
push @events => do_it_2();
}; # Report line is here
is($trace->report->line, 2806, "Nesting tool reported correct line");
is($events[0]->report->line, 2801, "Got nested line, our tool");
is($events[1]->report->line, 2200, "Nested, but tool is not 'provided' so goes up to provided");
is($events[2]->report->line, 2803, "Got nested line external tool");
is($events[3]->report->line, 2804, "Got nested line legacy tool");
is($events[4]->report->line, 2805, "Got nested line deeper legacy tool");
@events = ();
my $outer;
# line 2900
$outer = nestit {
$trace = nestit {
push @events => explodable();
push @events => explodadouble();
push @events => explode();
push @events => do_it();
push @events => do_it_2();
}; # Report line is here
};
# line 2920
is($outer->report->line, 2908, "Nesting tool reported correct line");
is($trace->report->line, 2907, "Nesting tool reported correct line");
# line 2930
is($events[0]->report->line, 2902, "Got nested line, our tool");
is($events[1]->report->line, 2200, "Nested, but tool is not 'provided' so goes up to provided");
is($events[2]->report->line, 2904, "Got nested line external tool");
is($events[3]->report->line, 2905, "Got nested line legacy tool");
is($events[4]->report->line, 2906, "Got nested line deeper legacy tool");
@events = ();
# line 3000
$trace = nonest {
push @events => explodable();
push @events => explodadouble();
push @events => explode();
push @events => do_it();
push @events => do_it_2();
}; # Report line is here
is($trace->report->line, 3006, "NoNesting tool reported correct line");
is($events[0]->report->line, 3006, "Lowest tool is nonest, so these get squashed (Which is why you use nesting)");
is($events[1]->report->line, 3006, "Lowest tool is nonest, so these get squashed (Which is why you use nesting)");
is($events[2]->report->line, 3006, "Lowest tool is nonest, so these get squashed (Which is why you use nesting)");
is($events[3]->report->line, 3006, "Lowest tool is nonest, so these get squashed(Legacy) (Which is why you use nesting)");
is($events[4]->report->line, 3006, "Lowest tool is nonest, so these get squashed(Legacy) (Which is why you use nesting)");
@events = ();
# line 3100
$trace = do_nestit {
push @events => explodable();
push @events => explodadouble();
push @events => explode();
push @events => do_it();
push @events => do_it_2();
}; # Report line is here
is($trace->report->line, 3106, "Nesting tool reported correct line");
is($events[0]->report->line, 3101, "Got nested line, our tool");
is($events[1]->report->line, 2200, "Nested, but tool is not 'provided' so goes up to provided");
is($events[2]->report->line, 3103, "Got nested line external tool");
is($events[3]->report->line, 3104, "Got nested line legacy tool");
is($events[4]->report->line, 3105, "Got nested line deeper legacy tool");
done_testing;
|
