Filename | /home/micha/.plenv/versions/5.38.2/lib/perl5/site_perl/5.38.2/Test2/Formatter/TAP.pm |
Statements | Executed 121 statements in 1.98ms |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
1 | 1 | 1 | 171µs | 200µs | BEGIN@17 | Test2::Formatter::TAP::
3 | 2 | 1 | 26µs | 144µs | write | Test2::Formatter::TAP::
3 | 1 | 1 | 18µs | 89µs | print_optimal_pass | Test2::Formatter::TAP::
4 | 4 | 1 | 17µs | 20µs | _autoflush | Test2::Formatter::TAP::
2 | 1 | 1 | 14µs | 25µs | event_tap | Test2::Formatter::TAP::
1 | 1 | 1 | 13µs | 78µs | _open_handles | Test2::Formatter::TAP::
1 | 1 | 1 | 11µs | 25µs | BEGIN@89 | Test2::Formatter::TAP::
1 | 1 | 1 | 9µs | 11µs | BEGIN@2 | Test2::Formatter::TAP::
1 | 1 | 1 | 7µs | 21µs | BEGIN@3 | Test2::Formatter::TAP::
1 | 1 | 1 | 6µs | 77µs | BEGIN@9 | Test2::Formatter::TAP::
1 | 1 | 1 | 4µs | 16µs | BEGIN@113 | Test2::Formatter::TAP::
1 | 1 | 1 | 4µs | 19µs | BEGIN@7 | Test2::Formatter::TAP::
1 | 1 | 1 | 4µs | 82µs | init | Test2::Formatter::TAP::
1 | 1 | 1 | 4µs | 4µs | plan_tap | Test2::Formatter::TAP::
1 | 1 | 1 | 2µs | 2µs | summary_tap | Test2::Formatter::TAP::
1 | 1 | 1 | 300ns | 300ns | OUT_ERR (xsub) | Test2::Formatter::TAP::
0 | 0 | 0 | 0s | 0s | __ANON__[:90] | Test2::Formatter::TAP::
0 | 0 | 0 | 0s | 0s | assert_tap | Test2::Formatter::TAP::
0 | 0 | 0 | 0s | 0s | calc_table_size | Test2::Formatter::TAP::
0 | 0 | 0 | 0s | 0s | debug_tap | Test2::Formatter::TAP::
0 | 0 | 0 | 0s | 0s | encoding | Test2::Formatter::TAP::
0 | 0 | 0 | 0s | 0s | error_tap | Test2::Formatter::TAP::
0 | 0 | 0 | 0s | 0s | halt_tap | Test2::Formatter::TAP::
0 | 0 | 0 | 0s | 0s | hide_buffered | Test2::Formatter::TAP::
0 | 0 | 0 | 0s | 0s | info_tap | Test2::Formatter::TAP::
0 | 0 | 0 | 0s | 0s | no_subtest_space | Test2::Formatter::TAP::
0 | 0 | 0 | 0s | 0s | supports_tables | Test2::Formatter::TAP::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | package Test2::Formatter::TAP; | ||||
2 | 2 | 16µs | 2 | 12µs | # spent 11µs (9+1) within Test2::Formatter::TAP::BEGIN@2 which was called:
# once (9µs+1µs) by Test::Builder::Formatter::BEGIN@7 at line 2 # spent 11µs making 1 call to Test2::Formatter::TAP::BEGIN@2
# spent 1µs making 1 call to strict::import |
3 | 2 | 23µs | 2 | 36µs | # spent 21µs (7+14) within Test2::Formatter::TAP::BEGIN@3 which was called:
# once (7µs+14µs) by Test::Builder::Formatter::BEGIN@7 at line 3 # spent 21µs making 1 call to Test2::Formatter::TAP::BEGIN@3
# spent 14µs making 1 call to warnings::import |
4 | |||||
5 | 1 | 400ns | our $VERSION = '1.302198'; | ||
6 | |||||
7 | 2 | 18µs | 2 | 34µs | # spent 19µs (4+15) within Test2::Formatter::TAP::BEGIN@7 which was called:
# once (4µs+15µs) by Test::Builder::Formatter::BEGIN@7 at line 7 # spent 19µs making 1 call to Test2::Formatter::TAP::BEGIN@7
# spent 15µs making 1 call to Exporter::import |
8 | |||||
9 | 1 | 2µs | 1 | 72µs | # spent 77µs (6+72) within Test2::Formatter::TAP::BEGIN@9 which was called:
# once (6µs+72µs) by Test::Builder::Formatter::BEGIN@7 at line 12 # spent 72µs making 1 call to Test2::Util::HashBase::import |
10 | no_numbers handles _encoding _last_fh | ||||
11 | -made_assertion | ||||
12 | 1 | 38µs | 1 | 77µs | }; # spent 77µs making 1 call to Test2::Formatter::TAP::BEGIN@9 |
13 | |||||
14 | sub OUT_STD() { 0 } | ||||
15 | sub OUT_ERR() { 1 } | ||||
16 | |||||
17 | 2 | 304µs | 1 | 200µs | # spent 200µs (171+29) within Test2::Formatter::TAP::BEGIN@17 which was called:
# once (171µs+29µs) by Test::Builder::Formatter::BEGIN@7 at line 17 # spent 200µs making 1 call to Test2::Formatter::TAP::BEGIN@17 |
18 | |||||
19 | 1 | 100ns | my $supports_tables; | ||
20 | sub supports_tables { | ||||
21 | if (!defined $supports_tables) { | ||||
22 | local $SIG{__DIE__} = 'DEFAULT'; | ||||
23 | local $@; | ||||
24 | $supports_tables | ||||
25 | = ($INC{'Term/Table.pm'} && $INC{'Term/Table/Util.pm'}) | ||||
26 | || eval { require Term::Table; require Term::Table::Util; 1 } | ||||
27 | || 0; | ||||
28 | } | ||||
29 | return $supports_tables; | ||||
30 | } | ||||
31 | |||||
32 | # spent 20µs (17+2) within Test2::Formatter::TAP::_autoflush which was called 4 times, avg 5µs/call:
# once (10µs+1µs) by Test::Builder::Formatter::BEGIN@7 at line 39
# once (3µs+600ns) by Test::Builder::Formatter::BEGIN@7 at line 40
# once (3µs+400ns) by Test2::Formatter::TAP::_open_handles at line 60
# once (2µs+100ns) by Test2::Formatter::TAP::_open_handles at line 61 | ||||
33 | 4 | 1µs | my($fh) = pop; | ||
34 | 4 | 9µs | 4 | 2µs | my $old_fh = select $fh; # spent 2µs making 4 calls to CORE::select, avg 400ns/call |
35 | 4 | 2µs | $| = 1; | ||
36 | 4 | 11µs | 4 | 700ns | select $old_fh; # spent 700ns making 4 calls to CORE::select, avg 175ns/call |
37 | } | ||||
38 | |||||
39 | 1 | 2µs | 1 | 11µs | _autoflush(\*STDOUT); # spent 11µs making 1 call to Test2::Formatter::TAP::_autoflush |
40 | 1 | 600ns | 1 | 3µs | _autoflush(\*STDERR); # spent 3µs making 1 call to Test2::Formatter::TAP::_autoflush |
41 | |||||
42 | sub hide_buffered { 1 } | ||||
43 | |||||
44 | # spent 82µs (4+78) within Test2::Formatter::TAP::init which was called:
# once (4µs+78µs) by Test::Builder::Formatter::init at line 21 of Test/Builder/Formatter.pm | ||||
45 | 1 | 100ns | my $self = shift; | ||
46 | |||||
47 | 1 | 2µs | 1 | 78µs | $self->{+HANDLES} ||= $self->_open_handles; # spent 78µs making 1 call to Test2::Formatter::TAP::_open_handles |
48 | 1 | 2µs | if(my $enc = delete $self->{encoding}) { | ||
49 | $self->encoding($enc); | ||||
50 | } | ||||
51 | } | ||||
52 | |||||
53 | # spent 78µs (13+65) within Test2::Formatter::TAP::_open_handles which was called:
# once (13µs+65µs) by Test2::Formatter::TAP::init at line 47 | ||||
54 | 1 | 100ns | my $self = shift; | ||
55 | |||||
56 | 1 | 300ns | require Test2::API; | ||
57 | 1 | 1µs | 2 | 37µs | my $out = clone_io(Test2::API::test2_stdout()); # spent 36µs making 1 call to Test2::Util::clone_io
# spent 600ns making 1 call to Test2::API::test2_stdout |
58 | 1 | 1µs | 2 | 23µs | my $err = clone_io(Test2::API::test2_stderr()); # spent 22µs making 1 call to Test2::Util::clone_io
# spent 500ns making 1 call to Test2::API::test2_stderr |
59 | |||||
60 | 1 | 600ns | 1 | 3µs | _autoflush($out); # spent 3µs making 1 call to Test2::Formatter::TAP::_autoflush |
61 | 1 | 300ns | 1 | 2µs | _autoflush($err); # spent 2µs making 1 call to Test2::Formatter::TAP::_autoflush |
62 | |||||
63 | 1 | 2µs | return [$out, $err]; | ||
64 | } | ||||
65 | |||||
66 | sub encoding { | ||||
67 | my $self = shift; | ||||
68 | |||||
69 | if ($] ge "5.007003" and @_) { | ||||
70 | my ($enc) = @_; | ||||
71 | my $handles = $self->{+HANDLES}; | ||||
72 | |||||
73 | # https://rt.perl.org/Public/Bug/Display.html?id=31923 | ||||
74 | # If utf8 is requested we use ':utf8' instead of ':encoding(utf8)' in | ||||
75 | # order to avoid the thread segfault. | ||||
76 | if ($enc =~ m/^utf-?8$/i) { | ||||
77 | binmode($_, ":utf8") for @$handles; | ||||
78 | } | ||||
79 | else { | ||||
80 | binmode($_, ":encoding($enc)") for @$handles; | ||||
81 | } | ||||
82 | $self->{+_ENCODING} = $enc; | ||||
83 | } | ||||
84 | |||||
85 | return $self->{+_ENCODING}; | ||||
86 | } | ||||
87 | |||||
88 | 1 | 500ns | if ($^C) { | ||
89 | 2 | 104µs | 2 | 38µs | # spent 25µs (11+14) within Test2::Formatter::TAP::BEGIN@89 which was called:
# once (11µs+14µs) by Test::Builder::Formatter::BEGIN@7 at line 89 # spent 25µs making 1 call to Test2::Formatter::TAP::BEGIN@89
# spent 14µs making 1 call to warnings::unimport |
90 | *write = sub {}; | ||||
91 | } | ||||
92 | # spent 144µs (26+119) within Test2::Formatter::TAP::write which was called 3 times, avg 48µs/call:
# 2 times (20µs+32µs) by Test2::Hub::process at line 373 of Test2/Hub.pm, avg 26µs/call
# once (6µs+87µs) by Test2::Hub::process at line 334 of Test2/Hub.pm | ||||
93 | 3 | 1µs | my ($self, $e, $num, $f) = @_; | ||
94 | |||||
95 | # The most common case, a pass event with no amnesty and a normal name. | ||||
96 | 3 | 7µs | 3 | 89µs | return if $self->print_optimal_pass($e, $num); # spent 89µs making 3 calls to Test2::Formatter::TAP::print_optimal_pass, avg 30µs/call |
97 | |||||
98 | 2 | 600ns | $f ||= $e->facet_data; | ||
99 | |||||
100 | 2 | 700ns | $self->encoding($f->{control}->{encoding}) if $f->{control}->{encoding}; | ||
101 | |||||
102 | 2 | 5µs | 2 | 25µs | my @tap = $self->event_tap($f, $num) or return; # spent 25µs making 2 calls to Test2::Formatter::TAP::event_tap, avg 12µs/call |
103 | |||||
104 | 1 | 300ns | $self->{+MADE_ASSERTION} = 1 if $f->{assert}; | ||
105 | |||||
106 | 1 | 500ns | my $nesting = $f->{trace}->{nested} || 0; | ||
107 | 1 | 300ns | my $handles = $self->{+HANDLES}; | ||
108 | 1 | 800ns | my $indent = ' ' x $nesting; | ||
109 | |||||
110 | # Local is expensive! Only do it if we really need to. | ||||
111 | 1 | 700ns | local($\, $,) = (undef, '') if $\ || $,; | ||
112 | 1 | 2µs | for my $set (@tap) { | ||
113 | 2 | 1.30ms | 2 | 28µs | # spent 16µs (4+12) within Test2::Formatter::TAP::BEGIN@113 which was called:
# once (4µs+12µs) by Test::Builder::Formatter::BEGIN@7 at line 113 # spent 16µs making 1 call to Test2::Formatter::TAP::BEGIN@113
# spent 12µs making 1 call to warnings::unimport |
114 | 1 | 700ns | my ($hid, $msg) = @$set; | ||
115 | 1 | 200ns | next unless $msg; | ||
116 | 1 | 500ns | my $io = $handles->[$hid] or next; | ||
117 | |||||
118 | print $io "\n" | ||||
119 | if $ENV{HARNESS_ACTIVE} | ||||
120 | && $hid == OUT_ERR | ||||
121 | 1 | 400ns | && $self->{+_LAST_FH} != $io | ||
122 | && $msg =~ m/^#\s*Failed( \(TODO\))? test /; | ||||
123 | |||||
124 | 1 | 200ns | $msg =~ s/^/$indent/mg if $nesting; | ||
125 | 1 | 6µs | 1 | 5µs | print $io $msg; # spent 5µs making 1 call to CORE::print |
126 | 1 | 800ns | $self->{+_LAST_FH} = $io; | ||
127 | } | ||||
128 | } | ||||
129 | |||||
130 | # spent 89µs (18+71) within Test2::Formatter::TAP::print_optimal_pass which was called 3 times, avg 30µs/call:
# 3 times (18µs+71µs) by Test2::Formatter::TAP::write at line 96, avg 30µs/call | ||||
131 | 3 | 800ns | my ($self, $e, $num) = @_; | ||
132 | |||||
133 | 3 | 900ns | my $type = ref($e); | ||
134 | |||||
135 | # Only optimal if this is a Pass or a passing Ok | ||||
136 | 3 | 3µs | return unless $type eq 'Test2::Event::Pass' || ($type eq 'Test2::Event::Ok' && $e->{pass}); | ||
137 | |||||
138 | # Amnesty requires further processing (todo is a form of amnesty) | ||||
139 | 1 | 1µs | return if ($e->{amnesty} && @{$e->{amnesty}}) || defined($e->{todo}); | ||
140 | |||||
141 | # A name with a newline or hash symbol needs extra processing | ||||
142 | 1 | 300ns | return if defined($e->{name}) && (-1 != index($e->{name}, "\n") || -1 != index($e->{name}, '#')); | ||
143 | |||||
144 | 1 | 400ns | my $ok = 'ok'; | ||
145 | 1 | 1µs | $ok .= " $num" if $num && !$self->{+NO_NUMBERS}; | ||
146 | 1 | 700ns | $ok .= defined($e->{name}) ? " - $e->{name}\n" : "\n"; | ||
147 | |||||
148 | 1 | 500ns | if (my $nesting = $e->{trace}->{nested}) { | ||
149 | my $indent = ' ' x $nesting; | ||||
150 | $ok = "$indent$ok"; | ||||
151 | } | ||||
152 | |||||
153 | 1 | 800ns | my $io = $self->{+HANDLES}->[OUT_STD]; | ||
154 | |||||
155 | 1 | 1µs | local($\, $,) = (undef, '') if $\ || $,; | ||
156 | 1 | 76µs | 1 | 71µs | print $io $ok; # spent 71µs making 1 call to CORE::print |
157 | 1 | 800ns | $self->{+_LAST_FH} = $io; | ||
158 | |||||
159 | 1 | 3µs | return 1; | ||
160 | } | ||||
161 | |||||
162 | # spent 25µs (14+11) within Test2::Formatter::TAP::event_tap which was called 2 times, avg 12µs/call:
# 2 times (14µs+11µs) by Test2::Formatter::TAP::write at line 102, avg 12µs/call | ||||
163 | 2 | 600ns | my ($self, $f, $num) = @_; | ||
164 | |||||
165 | 2 | 400ns | my @tap; | ||
166 | |||||
167 | # If this IS the first event the plan should come first | ||||
168 | # (plan must be before or after assertions, not in the middle) | ||||
169 | 2 | 3µs | 1 | 9µs | push @tap => $self->plan_tap($f) if $f->{plan} && !$self->{+MADE_ASSERTION}; # spent 9µs making 1 call to Test::Builder::Formatter::plan_tap |
170 | |||||
171 | # The assertion is most important, if present. | ||||
172 | 2 | 500ns | if ($f->{assert}) { | ||
173 | push @tap => $self->assert_tap($f, $num); | ||||
174 | push @tap => $self->debug_tap($f, $num) unless $f->{assert}->{no_debug} || $f->{assert}->{pass}; | ||||
175 | } | ||||
176 | |||||
177 | # Almost as important as an assertion | ||||
178 | 2 | 400ns | push @tap => $self->error_tap($f) if $f->{errors}; | ||
179 | |||||
180 | # Now lets see the diagnostics messages | ||||
181 | 2 | 400ns | push @tap => $self->info_tap($f) if $f->{info}; | ||
182 | |||||
183 | # If this IS NOT the first event the plan should come last | ||||
184 | # (plan must be before or after assertions, not in the middle) | ||||
185 | 2 | 400ns | push @tap => $self->plan_tap($f) if $self->{+MADE_ASSERTION} && $f->{plan}; | ||
186 | |||||
187 | # Bail out | ||||
188 | 2 | 500ns | push @tap => $self->halt_tap($f) if $f->{control}->{halt}; | ||
189 | |||||
190 | 2 | 3µs | return @tap if @tap; | ||
191 | 1 | 300ns | return @tap if $f->{control}->{halt}; | ||
192 | 1 | 1µs | return @tap if grep { $f->{$_} } qw/assert plan info errors/; | ||
193 | |||||
194 | # Use the summary as a fallback if nothing else is usable. | ||||
195 | 1 | 4µs | 1 | 2µs | return $self->summary_tap($f, $num); # spent 2µs making 1 call to Test2::Formatter::TAP::summary_tap |
196 | } | ||||
197 | |||||
198 | sub error_tap { | ||||
199 | my $self = shift; | ||||
200 | my ($f) = @_; | ||||
201 | |||||
202 | my $IO = ($f->{amnesty} && @{$f->{amnesty}}) ? OUT_STD : OUT_ERR; | ||||
203 | |||||
204 | return map { | ||||
205 | my $details = $_->{details}; | ||||
206 | |||||
207 | my $msg; | ||||
208 | if (ref($details)) { | ||||
209 | require Data::Dumper; | ||||
210 | my $dumper = Data::Dumper->new([$details])->Indent(2)->Terse(1)->Pad('# ')->Useqq(1)->Sortkeys(1); | ||||
211 | chomp($msg = $dumper->Dump); | ||||
212 | } | ||||
213 | else { | ||||
214 | chomp($msg = $details); | ||||
215 | $msg =~ s/^/# /; | ||||
216 | $msg =~ s/\n/\n# /g; | ||||
217 | } | ||||
218 | |||||
219 | [$IO, "$msg\n"]; | ||||
220 | } @{$f->{errors}}; | ||||
221 | } | ||||
222 | |||||
223 | # spent 4µs within Test2::Formatter::TAP::plan_tap which was called:
# once (4µs+0s) by Test::Builder::Formatter::plan_tap at line 29 of Test/Builder/Formatter.pm | ||||
224 | 1 | 200ns | my $self = shift; | ||
225 | 1 | 200ns | my ($f) = @_; | ||
226 | 1 | 500ns | my $plan = $f->{plan} or return; | ||
227 | |||||
228 | 1 | 400ns | return if $plan->{none}; | ||
229 | |||||
230 | 1 | 300ns | if ($plan->{skip}) { | ||
231 | my $reason = $plan->{details} or return [OUT_STD, "1..0 # SKIP\n"]; | ||||
232 | chomp($reason); | ||||
233 | return [OUT_STD, '1..0 # SKIP ' . $reason . "\n"]; | ||||
234 | } | ||||
235 | |||||
236 | 1 | 3µs | return [OUT_STD, "1.." . $plan->{count} . "\n"]; | ||
237 | } | ||||
238 | |||||
239 | sub no_subtest_space { 0 } | ||||
240 | sub assert_tap { | ||||
241 | my $self = shift; | ||||
242 | my ($f, $num) = @_; | ||||
243 | |||||
244 | my $assert = $f->{assert} or return; | ||||
245 | my $pass = $assert->{pass}; | ||||
246 | my $name = $assert->{details}; | ||||
247 | |||||
248 | my $ok = $pass ? 'ok' : 'not ok'; | ||||
249 | $ok .= " $num" if $num && !$self->{+NO_NUMBERS}; | ||||
250 | |||||
251 | # The regex form is ~250ms, the index form is ~50ms | ||||
252 | my @extra; | ||||
253 | defined($name) && ( | ||||
254 | (index($name, "\n") != -1 && (($name, @extra) = split(/\n\r?/, $name, -1))), | ||||
255 | ((index($name, "#" ) != -1 || substr($name, -1) eq '\\') && (($name =~ s|\\|\\\\|g), ($name =~ s|#|\\#|g))) | ||||
256 | ); | ||||
257 | |||||
258 | my $extra_space = @extra ? ' ' x (length($ok) + 2) : ''; | ||||
259 | my $extra_indent = ''; | ||||
260 | |||||
261 | my ($directives, $reason, $is_skip); | ||||
262 | if ($f->{amnesty}) { | ||||
263 | my %directives; | ||||
264 | |||||
265 | for my $am (@{$f->{amnesty}}) { | ||||
266 | next if $am->{inherited}; | ||||
267 | my $tag = $am->{tag} or next; | ||||
268 | $is_skip = 1 if $tag eq 'skip'; | ||||
269 | |||||
270 | $directives{$tag} ||= $am->{details}; | ||||
271 | } | ||||
272 | |||||
273 | my %seen; | ||||
274 | |||||
275 | # Sort so that TODO comes before skip even on systems where lc sorts | ||||
276 | # before uc, as other code depends on that ordering. | ||||
277 | my @order = grep { !$seen{$_}++ } sort { lc $b cmp lc $a } keys %directives; | ||||
278 | |||||
279 | $directives = ' # ' . join ' & ' => @order; | ||||
280 | |||||
281 | for my $tag ('skip', @order) { | ||||
282 | next unless defined($directives{$tag}) && length($directives{$tag}); | ||||
283 | $reason = $directives{$tag}; | ||||
284 | last; | ||||
285 | } | ||||
286 | } | ||||
287 | |||||
288 | $ok .= " - $name" if defined $name && !($is_skip && !$name); | ||||
289 | |||||
290 | my @subtap; | ||||
291 | if ($f->{parent} && $f->{parent}->{buffered}) { | ||||
292 | $ok .= ' {'; | ||||
293 | |||||
294 | # In a verbose harness we indent the extra since they will appear | ||||
295 | # inside the subtest braces. This helps readability. In a non-verbose | ||||
296 | # harness we do not do this because it is less readable. | ||||
297 | if ($ENV{HARNESS_IS_VERBOSE} || !$ENV{HARNESS_ACTIVE}) { | ||||
298 | $extra_indent = " "; | ||||
299 | $extra_space = ' '; | ||||
300 | } | ||||
301 | |||||
302 | # Render the sub-events, we use our own counter for these. | ||||
303 | my $count = 0; | ||||
304 | @subtap = map { | ||||
305 | my $f2 = $_; | ||||
306 | |||||
307 | # Bump the count for any event that should bump it. | ||||
308 | $count++ if $f2->{assert}; | ||||
309 | |||||
310 | # This indents all output lines generated for the sub-events. | ||||
311 | # index 0 is the filehandle, index 1 is the message we want to indent. | ||||
312 | map { $_->[1] =~ s/^(.*\S.*)$/ $1/mg; $_ } $self->event_tap($f2, $count); | ||||
313 | } @{$f->{parent}->{children}}; | ||||
314 | |||||
315 | push @subtap => [OUT_STD, "}\n"]; | ||||
316 | } | ||||
317 | |||||
318 | if ($directives) { | ||||
319 | $directives = ' # TODO & SKIP' if $directives eq ' # TODO & skip'; | ||||
320 | $ok .= $directives; | ||||
321 | $ok .= " $reason" if defined($reason); | ||||
322 | } | ||||
323 | |||||
324 | $extra_space = ' ' if $self->no_subtest_space; | ||||
325 | |||||
326 | my @out = ([OUT_STD, "$ok\n"]); | ||||
327 | push @out => map {[OUT_STD, "${extra_indent}#${extra_space}$_\n"]} @extra if @extra; | ||||
328 | push @out => @subtap; | ||||
329 | |||||
330 | return @out; | ||||
331 | } | ||||
332 | |||||
333 | sub debug_tap { | ||||
334 | my ($self, $f, $num) = @_; | ||||
335 | |||||
336 | # Figure out the debug info, this is typically the file name and line | ||||
337 | # number, but can also be a custom message. If no trace object is provided | ||||
338 | # then we have nothing useful to display. | ||||
339 | my $name = $f->{assert}->{details}; | ||||
340 | my $trace = $f->{trace}; | ||||
341 | |||||
342 | my $debug = "[No trace info available]"; | ||||
343 | if ($trace->{details}) { | ||||
344 | $debug = $trace->{details}; | ||||
345 | } | ||||
346 | elsif ($trace->{frame}) { | ||||
347 | my ($pkg, $file, $line) = @{$trace->{frame}}; | ||||
348 | $debug = "at $file line $line." if $file && $line; | ||||
349 | } | ||||
350 | |||||
351 | my $amnesty = $f->{amnesty} && @{$f->{amnesty}} | ||||
352 | ? ' (with amnesty)' | ||||
353 | : ''; | ||||
354 | |||||
355 | # Create the initial diagnostics. If the test has a name we put the debug | ||||
356 | # info on a second line, this behavior is inherited from Test::Builder. | ||||
357 | my $msg = defined($name) | ||||
358 | ? qq[# Failed test${amnesty} '$name'\n# $debug\n] | ||||
359 | : qq[# Failed test${amnesty} $debug\n]; | ||||
360 | |||||
361 | my $IO = $f->{amnesty} && @{$f->{amnesty}} ? OUT_STD : OUT_ERR; | ||||
362 | |||||
363 | return [$IO, $msg]; | ||||
364 | } | ||||
365 | |||||
366 | sub halt_tap { | ||||
367 | my ($self, $f) = @_; | ||||
368 | |||||
369 | return if $f->{trace}->{nested} && !$f->{trace}->{buffered}; | ||||
370 | my $details = $f->{control}->{details}; | ||||
371 | |||||
372 | return [OUT_STD, "Bail out!\n"] unless defined($details) && length($details); | ||||
373 | return [OUT_STD, "Bail out! $details\n"]; | ||||
374 | } | ||||
375 | |||||
376 | sub info_tap { | ||||
377 | my ($self, $f) = @_; | ||||
378 | |||||
379 | return map { | ||||
380 | my $details = $_->{details}; | ||||
381 | my $table = $_->{table}; | ||||
382 | |||||
383 | my $IO = $_->{debug} && !($f->{amnesty} && @{$f->{amnesty}}) ? OUT_ERR : OUT_STD; | ||||
384 | |||||
385 | my $msg; | ||||
386 | if ($table && $self->supports_tables) { | ||||
387 | $msg = join "\n" => map { "# $_" } Term::Table->new( | ||||
388 | header => $table->{header}, | ||||
389 | rows => $table->{rows}, | ||||
390 | collapse => $table->{collapse}, | ||||
391 | no_collapse => $table->{no_collapse}, | ||||
392 | sanitize => 1, | ||||
393 | mark_tail => 1, | ||||
394 | max_width => $self->calc_table_size($f), | ||||
395 | )->render(); | ||||
396 | } | ||||
397 | elsif (ref($details)) { | ||||
398 | require Data::Dumper; | ||||
399 | my $dumper = Data::Dumper->new([$details])->Indent(2)->Terse(1)->Pad('# ')->Useqq(1)->Sortkeys(1); | ||||
400 | chomp($msg = $dumper->Dump); | ||||
401 | } | ||||
402 | else { | ||||
403 | chomp($msg = $details); | ||||
404 | $msg =~ s/^/# /; | ||||
405 | $msg =~ s/\n/\n# /g; | ||||
406 | } | ||||
407 | |||||
408 | [$IO, "$msg\n"]; | ||||
409 | } @{$f->{info}}; | ||||
410 | } | ||||
411 | |||||
412 | # spent 2µs within Test2::Formatter::TAP::summary_tap which was called:
# once (2µs+0s) by Test2::Formatter::TAP::event_tap at line 195 | ||||
413 | 1 | 400ns | my ($self, $f, $num) = @_; | ||
414 | |||||
415 | 1 | 600ns | return if $f->{about}->{no_display}; | ||
416 | |||||
417 | 1 | 2µs | my $summary = $f->{about}->{details} or return; | ||
418 | chomp($summary); | ||||
419 | $summary =~ s/^/# /smg; | ||||
420 | |||||
421 | return [OUT_STD, "$summary\n"]; | ||||
422 | } | ||||
423 | |||||
424 | sub calc_table_size { | ||||
425 | my $self = shift; | ||||
426 | my ($f) = @_; | ||||
427 | |||||
428 | my $term = Term::Table::Util::term_size(); | ||||
429 | my $nesting = 2 + (($f->{trace}->{nested} || 0) * 4); # 4 spaces per level, also '# ' prefix | ||||
430 | my $total = $term - $nesting; | ||||
431 | |||||
432 | # Sane minimum width, any smaller and we are asking for pain | ||||
433 | return 50 if $total < 50; | ||||
434 | |||||
435 | return $total; | ||||
436 | } | ||||
437 | |||||
438 | 1 | 4µs | 1; | ||
439 | |||||
440 | __END__ | ||||
# spent 300ns within Test2::Formatter::TAP::OUT_ERR which was called:
# once (300ns+0s) by Test::Builder::Formatter::BEGIN@11 at line 15 of Test/Builder/Formatter.pm |