summaryrefslogtreecommitdiffstats
path: root/chromium/third_party/cygwin/lib/perl5/5.10/TAP/Formatter/Console.pm
diff options
context:
space:
mode:
Diffstat (limited to 'chromium/third_party/cygwin/lib/perl5/5.10/TAP/Formatter/Console.pm')
-rw-r--r--chromium/third_party/cygwin/lib/perl5/5.10/TAP/Formatter/Console.pm479
1 files changed, 0 insertions, 479 deletions
diff --git a/chromium/third_party/cygwin/lib/perl5/5.10/TAP/Formatter/Console.pm b/chromium/third_party/cygwin/lib/perl5/5.10/TAP/Formatter/Console.pm
deleted file mode 100644
index fd54af2d939..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/5.10/TAP/Formatter/Console.pm
+++ /dev/null
@@ -1,479 +0,0 @@
-package TAP::Formatter::Console;
-
-use strict;
-use TAP::Base ();
-use POSIX qw(strftime);
-
-use vars qw($VERSION @ISA);
-
-@ISA = qw(TAP::Base);
-
-my $MAX_ERRORS = 5;
-my %VALIDATION_FOR;
-
-BEGIN {
- %VALIDATION_FOR = (
- directives => sub { shift; shift },
- verbosity => sub { shift; shift },
- timer => sub { shift; shift },
- failures => sub { shift; shift },
- errors => sub { shift; shift },
- color => sub { shift; shift },
- jobs => sub { shift; shift },
- stdout => sub {
- my ( $self, $ref ) = @_;
- $self->_croak("option 'stdout' needs a filehandle")
- unless ( ref $ref || '' ) eq 'GLOB'
- or eval { $ref->can('print') };
- return $ref;
- },
- );
-
- my @getter_setters = qw(
- _longest
- _tests_without_extensions
- _printed_summary_header
- _colorizer
- );
-
- for my $method ( @getter_setters, keys %VALIDATION_FOR ) {
- no strict 'refs';
- *$method = sub {
- my $self = shift;
- return $self->{$method} unless @_;
- $self->{$method} = shift;
- };
- }
-}
-
-=head1 NAME
-
-TAP::Formatter::Console - Harness output delegate for default console output
-
-=head1 VERSION
-
-Version 3.10
-
-=cut
-
-$VERSION = '3.10';
-
-=head1 DESCRIPTION
-
-This provides console orientated output formatting for TAP::Harness.
-
-=head1 SYNOPSIS
-
- use TAP::Formatter::Console;
- my $harness = TAP::Formatter::Console->new( \%args );
-
-=cut
-
-sub _initialize {
- my ( $self, $arg_for ) = @_;
- $arg_for ||= {};
-
- $self->SUPER::_initialize($arg_for);
- my %arg_for = %$arg_for; # force a shallow copy
-
- $self->verbosity(0);
-
- for my $name ( keys %VALIDATION_FOR ) {
- my $property = delete $arg_for{$name};
- if ( defined $property ) {
- my $validate = $VALIDATION_FOR{$name};
- $self->$name( $self->$validate($property) );
- }
- }
-
- if ( my @props = keys %arg_for ) {
- $self->_croak(
- "Unknown arguments to " . __PACKAGE__ . "::new (@props)" );
- }
-
- $self->stdout( \*STDOUT ) unless $self->stdout;
-
- if ( $self->color ) {
- require TAP::Formatter::Color;
- $self->_colorizer( TAP::Formatter::Color->new );
- }
-
- return $self;
-}
-
-sub verbose { shift->verbosity >= 1 }
-sub quiet { shift->verbosity <= -1 }
-sub really_quiet { shift->verbosity <= -2 }
-sub silent { shift->verbosity <= -3 }
-
-=head1 METHODS
-
-=head2 Class Methods
-
-=head3 C<new>
-
- my %args = (
- verbose => 1,
- )
- my $harness = TAP::Formatter::Console->new( \%args );
-
-The constructor returns a new C<TAP::Formatter::Console> object. If
-a L<TAP::Harness> is created with no C<formatter> a
-C<TAP::Formatter::Console> is automatically created. If any of the
-following options were given to TAP::Harness->new they well be passed to
-this constructor which accepts an optional hashref whose allowed keys are:
-
-=over 4
-
-=item * C<verbosity>
-
-Set the verbosity level.
-
-=item * C<verbose>
-
-Printing individual test results to STDOUT.
-
-=item * C<timer>
-
-Append run time for each test to output. Uses L<Time::HiRes> if available.
-
-=item * C<failures>
-
-Only show test failures (this is a no-op if C<verbose> is selected).
-
-=item * C<quiet>
-
-Suppressing some test output (mostly failures while tests are running).
-
-=item * C<really_quiet>
-
-Suppressing everything but the tests summary.
-
-=item * C<silent>
-
-Suppressing all output.
-
-=item * C<errors>
-
-If parse errors are found in the TAP output, a note of this will be made
-in the summary report. To see all of the parse errors, set this argument to
-true:
-
- errors => 1
-
-=item * C<directives>
-
-If set to a true value, only test results with directives will be displayed.
-This overrides other settings such as C<verbose> or C<failures>.
-
-=item * C<stdout>
-
-A filehandle for catching standard output.
-
-=item * C<color>
-
-If defined specifies whether color output is desired. If C<color> is not
-defined it will default to color output if color support is available on
-the current platform and output is not being redirected.
-
-=item * C<jobs>
-
-The number of concurrent jobs this formatter will handle.
-
-=back
-
-Any keys for which the value is C<undef> will be ignored.
-
-=cut
-
-# new supplied by TAP::Base
-
-=head3 C<prepare>
-
-Called by Test::Harness before any test output is generated.
-
-=cut
-
-sub prepare {
- my ( $self, @tests ) = @_;
-
- my $longest = 0;
-
- my $tests_without_extensions = 0;
- foreach my $test (@tests) {
- $longest = length $test if length $test > $longest;
- if ( $test !~ /\.\w+$/ ) {
-
- # TODO: Coverage?
- $tests_without_extensions = 1;
- }
- }
-
- $self->_tests_without_extensions($tests_without_extensions);
- $self->_longest($longest);
-}
-
-sub _format_now { strftime "[%H:%M:%S]", localtime }
-
-sub _format_name {
- my ( $self, $test ) = @_;
- my $name = $test;
- my $extra = 0;
- unless ( $self->_tests_without_extensions ) {
- $name =~ s/(\.\w+)$//; # strip the .t or .pm
- $extra = length $1;
- }
- my $periods = '.' x ( $self->_longest + $extra + 4 - length $test );
-
- if ( $self->timer ) {
- my $stamp = $self->_format_now();
- return "$stamp $name$periods";
- }
- else {
- return "$name$periods";
- }
-
-}
-
-=head3 C<open_test>
-
-Called to create a new test session. A test session looks like this:
-
- my $session = $formatter->open_test( $test, $parser );
- while ( defined( my $result = $parser->next ) ) {
- $session->result($result);
- exit 1 if $result->is_bailout;
- }
- $session->close_test;
-
-=cut
-
-sub open_test {
- my ( $self, $test, $parser ) = @_;
-
- my $class
- = $self->jobs > 1
- ? 'TAP::Formatter::Console::ParallelSession'
- : 'TAP::Formatter::Console::Session';
-
- eval "require $class";
- $self->_croak($@) if $@;
-
- my $session = $class->new(
- { name => $test,
- formatter => $self,
- parser => $parser
- }
- );
-
- $session->header;
-
- return $session;
-}
-
-=head3 C<summary>
-
- $harness->summary( $aggregate );
-
-C<summary> prints the summary report after all tests are run. The argument is
-an aggregate.
-
-=cut
-
-sub summary {
- my ( $self, $aggregate ) = @_;
-
- return if $self->silent;
-
- my @t = $aggregate->descriptions;
- my $tests = \@t;
-
- my $runtime = $aggregate->elapsed_timestr;
-
- my $total = $aggregate->total;
- my $passed = $aggregate->passed;
-
- if ( $self->timer ) {
- $self->_output( $self->_format_now(), "\n" );
- }
-
- # TODO: Check this condition still works when all subtests pass but
- # the exit status is nonzero
-
- if ( $aggregate->all_passed ) {
- $self->_output("All tests successful.\n");
- }
-
- # ~TODO option where $aggregate->skipped generates reports
- if ( $total != $passed or $aggregate->has_problems ) {
- $self->_output("\nTest Summary Report");
- $self->_output("\n-------------------\n");
- foreach my $test (@$tests) {
- $self->_printed_summary_header(0);
- my ($parser) = $aggregate->parsers($test);
- $self->_output_summary_failure(
- 'failed',
- [ ' Failed test: ', ' Failed tests: ' ],
- $test, $parser
- );
- $self->_output_summary_failure(
- 'todo_passed',
- " TODO passed: ", $test, $parser
- );
-
- # ~TODO this cannot be the default
- #$self->_output_summary_failure( 'skipped', " Tests skipped: " );
-
- if ( my $exit = $parser->exit ) {
- $self->_summary_test_header( $test, $parser );
- $self->_failure_output(" Non-zero exit status: $exit\n");
- }
-
- if ( my @errors = $parser->parse_errors ) {
- my $explain;
- if ( @errors > $MAX_ERRORS && !$self->errors ) {
- $explain
- = "Displayed the first $MAX_ERRORS of "
- . scalar(@errors)
- . " TAP syntax errors.\n"
- . "Re-run prove with the -p option to see them all.\n";
- splice @errors, $MAX_ERRORS;
- }
- $self->_summary_test_header( $test, $parser );
- $self->_failure_output(
- sprintf " Parse errors: %s\n",
- shift @errors
- );
- foreach my $error (@errors) {
- my $spaces = ' ' x 16;
- $self->_failure_output("$spaces$error\n");
- }
- $self->_failure_output($explain) if $explain;
- }
- }
- }
- my $files = @$tests;
- $self->_output("Files=$files, Tests=$total, $runtime\n");
- my $status = $aggregate->get_status;
- $self->_output("Result: $status\n");
-}
-
-sub _output_summary_failure {
- my ( $self, $method, $name, $test, $parser ) = @_;
-
- # ugly hack. Must rethink this :(
- my $output = $method eq 'failed' ? '_failure_output' : '_output';
-
- if ( my @r = $parser->$method() ) {
- $self->_summary_test_header( $test, $parser );
- my ( $singular, $plural )
- = 'ARRAY' eq ref $name ? @$name : ( $name, $name );
- $self->$output( @r == 1 ? $singular : $plural );
- my @results = $self->_balanced_range( 40, @r );
- $self->$output( sprintf "%s\n" => shift @results );
- my $spaces = ' ' x 16;
- while (@results) {
- $self->$output( sprintf "$spaces%s\n" => shift @results );
- }
- }
-}
-
-sub _summary_test_header {
- my ( $self, $test, $parser ) = @_;
- return if $self->_printed_summary_header;
- my $spaces = ' ' x ( $self->_longest - length $test );
- $spaces = ' ' unless $spaces;
- my $output = $self->_get_output_method($parser);
- $self->$output(
- sprintf "$test$spaces(Wstat: %d Tests: %d Failed: %d)\n",
- $parser->wait, $parser->tests_run, scalar $parser->failed
- );
- $self->_printed_summary_header(1);
-}
-
-sub _output {
- my $self = shift;
-
- print { $self->stdout } @_;
-}
-
-# Use _colorizer delegate to set output color. NOP if we have no delegate
-sub _set_colors {
- my ( $self, @colors ) = @_;
- if ( my $colorizer = $self->_colorizer ) {
- my $output_func = $self->{_output_func} ||= sub {
- $self->_output(@_);
- };
- $colorizer->set_color( $output_func, $_ ) for @colors;
- }
-}
-
-sub _failure_output {
- my $self = shift;
- $self->_set_colors('red');
- my $out = join '', @_;
- my $has_newline = chomp $out;
- $self->_output($out);
- $self->_set_colors('reset');
- $self->_output($/)
- if $has_newline;
-}
-
-sub _balanced_range {
- my ( $self, $limit, @range ) = @_;
- @range = $self->_range(@range);
- my $line = "";
- my @lines;
- my $curr = 0;
- while (@range) {
- if ( $curr < $limit ) {
- my $range = ( shift @range ) . ", ";
- $line .= $range;
- $curr += length $range;
- }
- elsif (@range) {
- $line =~ s/, $//;
- push @lines => $line;
- $line = '';
- $curr = 0;
- }
- }
- if ($line) {
- $line =~ s/, $//;
- push @lines => $line;
- }
- return @lines;
-}
-
-sub _range {
- my ( $self, @numbers ) = @_;
-
- # shouldn't be needed, but subclasses might call this
- @numbers = sort { $a <=> $b } @numbers;
- my ( $min, @range );
-
- foreach my $i ( 0 .. $#numbers ) {
- my $num = $numbers[$i];
- my $next = $numbers[ $i + 1 ];
- if ( defined $next && $next == $num + 1 ) {
- if ( !defined $min ) {
- $min = $num;
- }
- }
- elsif ( defined $min ) {
- push @range => "$min-$num";
- undef $min;
- }
- else {
- push @range => $num;
- }
- }
- return @range;
-}
-
-sub _get_output_method {
- my ( $self, $parser ) = @_;
- return $parser->has_problems ? '_failure_output' : '_output';
-}
-
-1;
generated by cgit v1.2.3 (git 2.25.1) at 2024-05-08 01:09:03 +0000