diff options
Diffstat (limited to 'systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Formatter/TAP.pm')
-rwxr-xr-x | systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Formatter/TAP.pm | 47 |
1 files changed, 42 insertions, 5 deletions
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Formatter/TAP.pm b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Formatter/TAP.pm index 2082de7b8f..25961bf737 100755 --- a/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Formatter/TAP.pm +++ b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Formatter/TAP.pm @@ -2,7 +2,7 @@ package Test2::Formatter::TAP; use strict; use warnings; -our $VERSION = '1.302133'; +our $VERSION = '1.302162'; use Test2::Util qw/clone_io/; @@ -16,6 +16,18 @@ sub OUT_ERR() { 1 } BEGIN { require Test2::Formatter; our @ISA = qw(Test2::Formatter) } +# Not constants because this is a method, and can be overriden +BEGIN { + local $SIG{__DIE__} = 'DEFAULT'; + local $@; + if (($INC{'Term/Table.pm'} && $INC{'Term/Table/Util.pm'}) || eval { require Term::Table; require Term::Table::Util; 1 }) { + *supports_tables = sub { 1 }; + } + else { + *supports_tables = sub { 0 }; + } +} + sub _autoflush { my($fh) = pop; my $old_fh = select $fh; @@ -104,10 +116,9 @@ sub write { print $io "\n" if $ENV{HARNESS_ACTIVE} - && !$ENV{HARNESS_IS_VERBOSE} && $hid == OUT_ERR && $self->{+_LAST_FH} != $io - && $msg =~ m/^#\s*Failed test /; + && $msg =~ m/^#\s*Failed( \(TODO\))? test /; $msg =~ s/^/$indent/mg if $nesting; print $io $msg; @@ -363,11 +374,23 @@ sub info_tap { return map { my $details = $_->{details}; + my $table = $_->{table}; my $IO = $_->{debug} && !($f->{amnesty} && @{$f->{amnesty}}) ? OUT_ERR : OUT_STD; my $msg; - if (ref($details)) { + if ($table && $self->supports_tables) { + $msg = join "\n" => map { "# $_" } Term::Table->new( + header => $table->{header}, + rows => $table->{rows}, + collapse => $table->{collapse}, + no_collapse => $table->{no_collapse}, + sanitize => 1, + mark_tail => 1, + max_width => $self->calc_table_size($f), + )->render(); + } + elsif (ref($details)) { require Data::Dumper; my $dumper = Data::Dumper->new([$details])->Indent(2)->Terse(1)->Pad('# ')->Useqq(1)->Sortkeys(1); chomp($msg = $dumper->Dump); @@ -394,6 +417,20 @@ sub summary_tap { return [OUT_STD, "$summary\n"]; } +sub calc_table_size { + my $self = shift; + my ($f) = @_; + + my $term = Term::Table::Util::term_size(); + my $nesting = 2 + (($f->{trace}->{nested} || 0) * 4); # 4 spaces per level, also '# ' prefix + my $total = $term - $nesting; + + # Sane minimum width, any smaller and we are asking for pain + return 50 if $total < 50; + + return $total; +} + 1; __END__ @@ -477,7 +514,7 @@ F<http://github.com/Test-More/test-more/>. =head1 COPYRIGHT -Copyright 2018 Chad Granum E<lt>exodist@cpan.orgE<gt>. +Copyright 2019 Chad Granum E<lt>exodist@cpan.orgE<gt>. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. |