← Index
NYTProf Performance Profile   « line view »
For t/bug-md-11.t
  Run on Fri Mar 8 13:27:24 2024
Reported on Fri Mar 8 13:30:23 2024

Filename/home/micha/.plenv/versions/5.38.2/lib/perl5/site_perl/5.38.2/Test2/Formatter/TAP.pm
StatementsExecuted 121 statements in 1.98ms
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
111171µs200µsTest2::Formatter::TAP::::BEGIN@17Test2::Formatter::TAP::BEGIN@17
32126µs144µsTest2::Formatter::TAP::::writeTest2::Formatter::TAP::write
31118µs89µsTest2::Formatter::TAP::::print_optimal_passTest2::Formatter::TAP::print_optimal_pass
44117µs20µsTest2::Formatter::TAP::::_autoflushTest2::Formatter::TAP::_autoflush
21114µs25µsTest2::Formatter::TAP::::event_tapTest2::Formatter::TAP::event_tap
11113µs78µsTest2::Formatter::TAP::::_open_handlesTest2::Formatter::TAP::_open_handles
11111µs25µsTest2::Formatter::TAP::::BEGIN@89Test2::Formatter::TAP::BEGIN@89
1119µs11µsTest2::Formatter::TAP::::BEGIN@2Test2::Formatter::TAP::BEGIN@2
1117µs21µsTest2::Formatter::TAP::::BEGIN@3Test2::Formatter::TAP::BEGIN@3
1116µs77µsTest2::Formatter::TAP::::BEGIN@9Test2::Formatter::TAP::BEGIN@9
1114µs16µsTest2::Formatter::TAP::::BEGIN@113Test2::Formatter::TAP::BEGIN@113
1114µs19µsTest2::Formatter::TAP::::BEGIN@7Test2::Formatter::TAP::BEGIN@7
1114µs82µsTest2::Formatter::TAP::::initTest2::Formatter::TAP::init
1114µs4µsTest2::Formatter::TAP::::plan_tapTest2::Formatter::TAP::plan_tap
1112µs2µsTest2::Formatter::TAP::::summary_tapTest2::Formatter::TAP::summary_tap
111300ns300nsTest2::Formatter::TAP::::OUT_ERRTest2::Formatter::TAP::OUT_ERR (xsub)
0000s0sTest2::Formatter::TAP::::__ANON__[:90]Test2::Formatter::TAP::__ANON__[:90]
0000s0sTest2::Formatter::TAP::::assert_tapTest2::Formatter::TAP::assert_tap
0000s0sTest2::Formatter::TAP::::calc_table_sizeTest2::Formatter::TAP::calc_table_size
0000s0sTest2::Formatter::TAP::::debug_tapTest2::Formatter::TAP::debug_tap
0000s0sTest2::Formatter::TAP::::encodingTest2::Formatter::TAP::encoding
0000s0sTest2::Formatter::TAP::::error_tapTest2::Formatter::TAP::error_tap
0000s0sTest2::Formatter::TAP::::halt_tapTest2::Formatter::TAP::halt_tap
0000s0sTest2::Formatter::TAP::::hide_bufferedTest2::Formatter::TAP::hide_buffered
0000s0sTest2::Formatter::TAP::::info_tapTest2::Formatter::TAP::info_tap
0000s0sTest2::Formatter::TAP::::no_subtest_spaceTest2::Formatter::TAP::no_subtest_space
0000s0sTest2::Formatter::TAP::::supports_tablesTest2::Formatter::TAP::supports_tables
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments
Time
on line
Calls Time
in subs
Code
1package Test2::Formatter::TAP;
2216µs212µ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
use strict;
# spent 11µs making 1 call to Test2::Formatter::TAP::BEGIN@2 # spent 1µs making 1 call to strict::import
3223µs236µ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
use warnings;
# spent 21µs making 1 call to Test2::Formatter::TAP::BEGIN@3 # spent 14µs making 1 call to warnings::import
4
51400nsour $VERSION = '1.302198';
6
7218µs234µ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
use Test2::Util qw/clone_io/;
# spent 19µs making 1 call to Test2::Formatter::TAP::BEGIN@7 # spent 15µs making 1 call to Exporter::import
8
912µs172µ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
use Test2::Util::HashBase qw{
# spent 72µs making 1 call to Test2::Util::HashBase::import
10 no_numbers handles _encoding _last_fh
11 -made_assertion
12138µs177µs};
# spent 77µs making 1 call to Test2::Formatter::TAP::BEGIN@9
13
14sub OUT_STD() { 0 }
15sub OUT_ERR() { 1 }
16
172304µs1200µ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
BEGIN { require Test2::Formatter; our @ISA = qw(Test2::Formatter) }
# spent 200µs making 1 call to Test2::Formatter::TAP::BEGIN@17
18
191100nsmy $supports_tables;
20sub 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
sub _autoflush {
3341µs my($fh) = pop;
3449µs42µs my $old_fh = select $fh;
# spent 2µs making 4 calls to CORE::select, avg 400ns/call
3542µs $| = 1;
36411µs4700ns select $old_fh;
# spent 700ns making 4 calls to CORE::select, avg 175ns/call
37}
38
3912µs111µs_autoflush(\*STDOUT);
# spent 11µs making 1 call to Test2::Formatter::TAP::_autoflush
401600ns13µs_autoflush(\*STDERR);
# spent 3µs making 1 call to Test2::Formatter::TAP::_autoflush
41
42sub 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
sub init {
451100ns my $self = shift;
46
4712µs178µs $self->{+HANDLES} ||= $self->_open_handles;
# spent 78µs making 1 call to Test2::Formatter::TAP::_open_handles
4812µ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
sub _open_handles {
541100ns my $self = shift;
55
561300ns require Test2::API;
5711µs237µ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
5811µs223µ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
601600ns13µs _autoflush($out);
# spent 3µs making 1 call to Test2::Formatter::TAP::_autoflush
611300ns12µs _autoflush($err);
# spent 2µs making 1 call to Test2::Formatter::TAP::_autoflush
62
6312µs return [$out, $err];
64}
65
66sub 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
881500nsif ($^C) {
892104µs238µ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
no warnings 'redefine';
# 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
sub write {
9331µs my ($self, $e, $num, $f) = @_;
94
95 # The most common case, a pass event with no amnesty and a normal name.
9637µs389µ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
982600ns $f ||= $e->facet_data;
99
1002700ns $self->encoding($f->{control}->{encoding}) if $f->{control}->{encoding};
101
10225µs225µ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
1041300ns $self->{+MADE_ASSERTION} = 1 if $f->{assert};
105
1061500ns my $nesting = $f->{trace}->{nested} || 0;
1071300ns my $handles = $self->{+HANDLES};
1081800ns my $indent = ' ' x $nesting;
109
110 # Local is expensive! Only do it if we really need to.
1111700ns local($\, $,) = (undef, '') if $\ || $,;
11212µs for my $set (@tap) {
11321.30ms228µ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
no warnings 'uninitialized';
# spent 16µs making 1 call to Test2::Formatter::TAP::BEGIN@113 # spent 12µs making 1 call to warnings::unimport
1141700ns my ($hid, $msg) = @$set;
1151200ns next unless $msg;
1161500ns my $io = $handles->[$hid] or next;
117
118 print $io "\n"
119 if $ENV{HARNESS_ACTIVE}
120 && $hid == OUT_ERR
1211400ns && $self->{+_LAST_FH} != $io
122 && $msg =~ m/^#\s*Failed( \(TODO\))? test /;
123
1241200ns $msg =~ s/^/$indent/mg if $nesting;
12516µs15µs print $io $msg;
# spent 5µs making 1 call to CORE::print
1261800ns $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
sub print_optimal_pass {
1313800ns my ($self, $e, $num) = @_;
132
1333900ns my $type = ref($e);
134
135 # Only optimal if this is a Pass or a passing Ok
13633µ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)
13911µs return if ($e->{amnesty} && @{$e->{amnesty}}) || defined($e->{todo});
140
141 # A name with a newline or hash symbol needs extra processing
1421300ns return if defined($e->{name}) && (-1 != index($e->{name}, "\n") || -1 != index($e->{name}, '#'));
143
1441400ns my $ok = 'ok';
14511µs $ok .= " $num" if $num && !$self->{+NO_NUMBERS};
1461700ns $ok .= defined($e->{name}) ? " - $e->{name}\n" : "\n";
147
1481500ns if (my $nesting = $e->{trace}->{nested}) {
149 my $indent = ' ' x $nesting;
150 $ok = "$indent$ok";
151 }
152
1531800ns my $io = $self->{+HANDLES}->[OUT_STD];
154
15511µs local($\, $,) = (undef, '') if $\ || $,;
156176µs171µs print $io $ok;
# spent 71µs making 1 call to CORE::print
1571800ns $self->{+_LAST_FH} = $io;
158
15913µ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
sub event_tap {
1632600ns my ($self, $f, $num) = @_;
164
1652400ns 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)
16923µs19µ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.
1722500ns 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
1782400ns push @tap => $self->error_tap($f) if $f->{errors};
179
180 # Now lets see the diagnostics messages
1812400ns 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)
1852400ns push @tap => $self->plan_tap($f) if $self->{+MADE_ASSERTION} && $f->{plan};
186
187 # Bail out
1882500ns push @tap => $self->halt_tap($f) if $f->{control}->{halt};
189
19023µs return @tap if @tap;
1911300ns return @tap if $f->{control}->{halt};
19211µs return @tap if grep { $f->{$_} } qw/assert plan info errors/;
193
194 # Use the summary as a fallback if nothing else is usable.
19514µs12µs return $self->summary_tap($f, $num);
# spent 2µs making 1 call to Test2::Formatter::TAP::summary_tap
196}
197
198sub 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
sub plan_tap {
2241200ns my $self = shift;
2251200ns my ($f) = @_;
2261500ns my $plan = $f->{plan} or return;
227
2281400ns return if $plan->{none};
229
2301300ns 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
23613µs return [OUT_STD, "1.." . $plan->{count} . "\n"];
237}
238
239sub no_subtest_space { 0 }
240sub 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
333sub 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
366sub 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
376sub 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
sub summary_tap {
4131400ns my ($self, $f, $num) = @_;
414
4151600ns return if $f->{about}->{no_display};
416
41712µs my $summary = $f->{about}->{details} or return;
418 chomp($summary);
419 $summary =~ s/^/# /smg;
420
421 return [OUT_STD, "$summary\n"];
422}
423
424sub 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
43814µs1;
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
sub Test2::Formatter::TAP::OUT_ERR; # xsub