| 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 | Test2::Formatter::TAP::BEGIN@17 |
| 3 | 2 | 1 | 26µs | 144µs | Test2::Formatter::TAP::write |
| 3 | 1 | 1 | 18µs | 89µs | Test2::Formatter::TAP::print_optimal_pass |
| 4 | 4 | 1 | 17µs | 20µs | Test2::Formatter::TAP::_autoflush |
| 2 | 1 | 1 | 14µs | 25µs | Test2::Formatter::TAP::event_tap |
| 1 | 1 | 1 | 13µs | 78µs | Test2::Formatter::TAP::_open_handles |
| 1 | 1 | 1 | 11µs | 25µs | Test2::Formatter::TAP::BEGIN@89 |
| 1 | 1 | 1 | 9µs | 11µs | Test2::Formatter::TAP::BEGIN@2 |
| 1 | 1 | 1 | 7µs | 21µs | Test2::Formatter::TAP::BEGIN@3 |
| 1 | 1 | 1 | 6µs | 77µs | Test2::Formatter::TAP::BEGIN@9 |
| 1 | 1 | 1 | 4µs | 16µs | Test2::Formatter::TAP::BEGIN@113 |
| 1 | 1 | 1 | 4µs | 19µs | Test2::Formatter::TAP::BEGIN@7 |
| 1 | 1 | 1 | 4µs | 82µs | Test2::Formatter::TAP::init |
| 1 | 1 | 1 | 4µs | 4µs | Test2::Formatter::TAP::plan_tap |
| 1 | 1 | 1 | 2µs | 2µs | Test2::Formatter::TAP::summary_tap |
| 1 | 1 | 1 | 300ns | 300ns | Test2::Formatter::TAP::OUT_ERR (xsub) |
| 0 | 0 | 0 | 0s | 0s | Test2::Formatter::TAP::__ANON__[:90] |
| 0 | 0 | 0 | 0s | 0s | Test2::Formatter::TAP::assert_tap |
| 0 | 0 | 0 | 0s | 0s | Test2::Formatter::TAP::calc_table_size |
| 0 | 0 | 0 | 0s | 0s | Test2::Formatter::TAP::debug_tap |
| 0 | 0 | 0 | 0s | 0s | Test2::Formatter::TAP::encoding |
| 0 | 0 | 0 | 0s | 0s | Test2::Formatter::TAP::error_tap |
| 0 | 0 | 0 | 0s | 0s | Test2::Formatter::TAP::halt_tap |
| 0 | 0 | 0 | 0s | 0s | Test2::Formatter::TAP::hide_buffered |
| 0 | 0 | 0 | 0s | 0s | Test2::Formatter::TAP::info_tap |
| 0 | 0 | 0 | 0s | 0s | Test2::Formatter::TAP::no_subtest_space |
| 0 | 0 | 0 | 0s | 0s | Test2::Formatter::TAP::supports_tables |
| 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 |