Profile of Test2/Formatter/TAP.pm

← 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
Statements | Executed 121 statements in 1.98ms

Subroutines
Calls | P | F | Exclusive Time | Inclusive Time | Subroutine
--- | --- | --- | --- | --- | ---
1 | 1 | 1 | 171µs | 200µs | Test2::Formatter::TAP::::BEGIN@17Test2::Formatter::TAP::BEGIN@17
3 | 2 | 1 | 26µs | 144µs | Test2::Formatter::TAP::::writeTest2::Formatter::TAP::write
3 | 1 | 1 | 18µs | 89µs | Test2::Formatter::TAP::::print_optimal_passTest2::Formatter::TAP::print_optimal_pass
4 | 4 | 1 | 17µs | 20µs | Test2::Formatter::TAP::::_autoflushTest2::Formatter::TAP::_autoflush
2 | 1 | 1 | 14µs | 25µs | Test2::Formatter::TAP::::event_tapTest2::Formatter::TAP::event_tap
1 | 1 | 1 | 13µs | 78µs | Test2::Formatter::TAP::::_open_handlesTest2::Formatter::TAP::_open_handles
1 | 1 | 1 | 11µs | 25µs | Test2::Formatter::TAP::::BEGIN@89Test2::Formatter::TAP::BEGIN@89
1 | 1 | 1 | 9µs | 11µs | Test2::Formatter::TAP::::BEGIN@2Test2::Formatter::TAP::BEGIN@2
1 | 1 | 1 | 7µs | 21µs | Test2::Formatter::TAP::::BEGIN@3Test2::Formatter::TAP::BEGIN@3
1 | 1 | 1 | 6µs | 77µs | Test2::Formatter::TAP::::BEGIN@9Test2::Formatter::TAP::BEGIN@9
1 | 1 | 1 | 4µs | 16µs | Test2::Formatter::TAP::::BEGIN@113Test2::Formatter::TAP::BEGIN@113
1 | 1 | 1 | 4µs | 19µs | Test2::Formatter::TAP::::BEGIN@7Test2::Formatter::TAP::BEGIN@7
1 | 1 | 1 | 4µs | 82µs | Test2::Formatter::TAP::::initTest2::Formatter::TAP::init
1 | 1 | 1 | 4µs | 4µs | Test2::Formatter::TAP::::plan_tapTest2::Formatter::TAP::plan_tap
1 | 1 | 1 | 2µs | 2µs | Test2::Formatter::TAP::::summary_tapTest2::Formatter::TAP::summary_tap
1 | 1 | 1 | 300ns | 300ns | Test2::Formatter::TAP::::OUT_ERRTest2::Formatter::TAP::OUT_ERR (xsub)
0 | 0 | 0 | 0s | 0s | Test2::Formatter::TAP::::__ANON__[:90]Test2::Formatter::TAP::__ANON__[:90]
0 | 0 | 0 | 0s | 0s | Test2::Formatter::TAP::::assert_tapTest2::Formatter::TAP::assert_tap
0 | 0 | 0 | 0s | 0s | Test2::Formatter::TAP::::calc_table_sizeTest2::Formatter::TAP::calc_table_size
0 | 0 | 0 | 0s | 0s | Test2::Formatter::TAP::::debug_tapTest2::Formatter::TAP::debug_tap
0 | 0 | 0 | 0s | 0s | Test2::Formatter::TAP::::encodingTest2::Formatter::TAP::encoding
0 | 0 | 0 | 0s | 0s | Test2::Formatter::TAP::::error_tapTest2::Formatter::TAP::error_tap
0 | 0 | 0 | 0s | 0s | Test2::Formatter::TAP::::halt_tapTest2::Formatter::TAP::halt_tap
0 | 0 | 0 | 0s | 0s | Test2::Formatter::TAP::::hide_bufferedTest2::Formatter::TAP::hide_buffered
0 | 0 | 0 | 0s | 0s | Test2::Formatter::TAP::::info_tapTest2::Formatter::TAP::info_tap
0 | 0 | 0 | 0s | 0s | Test2::Formatter::TAP::::no_subtest_spaceTest2::Formatter::TAP::no_subtest_space
0 | 0 | 0 | 0s | 0s | Test2::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
--- | --- | --- | --- | --- | ---
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 use strict; # 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 use warnings; # 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 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 |  |  |  |  |
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 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
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 BEGIN { require Test2::Formatter; our @ISA = qw(Test2::Formatter) } # 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 sub _autoflush {
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 sub init {
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 sub _open_handles {
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 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 {
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 no warnings 'uninitialized'; # 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 sub print_optimal_pass {
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 sub event_tap {
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 sub plan_tap {
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 sub summary_tap {
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 sub Test2::Formatter::TAP::OUT_ERR; # xsub