<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;">package TAP::Formatter::Session;

use strict;
use warnings;

use base 'TAP::Base';

my @ACCESSOR;

BEGIN {

    @ACCESSOR = qw( name formatter parser show_count );

    for my $method (@ACCESSOR) {
        no strict 'refs';
        *$method = sub { shift-&gt;{$method} };
    }
}

=head1 NAME

TAP::Formatter::Session - Abstract base class for harness output delegate 

=head1 VERSION

Version 3.42

=cut

our $VERSION = '3.42';

=head1 METHODS

=head2 Class Methods

=head3 C&lt;new&gt;

 my %args = (
    formatter =&gt; $self,
 )
 my $harness = TAP::Formatter::Console::Session-&gt;new( \%args );

The constructor returns a new C&lt;TAP::Formatter::Console::Session&gt; object.

=over 4

=item * C&lt;formatter&gt;

=item * C&lt;parser&gt;

=item * C&lt;name&gt;

=item * C&lt;show_count&gt;

=back

=cut

sub _initialize {
    my ( $self, $arg_for ) = @_;
    $arg_for ||= {};

    $self-&gt;SUPER::_initialize($arg_for);
    my %arg_for = %$arg_for;    # force a shallow copy

    for my $name (@ACCESSOR) {
        $self-&gt;{$name} = delete $arg_for{$name};
    }

    if ( !defined $self-&gt;show_count ) {
        $self-&gt;{show_count} = 1;    # defaults to true
    }
    if ( $self-&gt;show_count ) {      # but may be a damned lie!
        $self-&gt;{show_count} = $self-&gt;_should_show_count;
    }

    if ( my @props = sort keys %arg_for ) {
        $self-&gt;_croak(
            "Unknown arguments to " . __PACKAGE__ . "::new (@props)" );
    }

    return $self;
}

=head3 C&lt;header&gt;

Output test preamble

=head3 C&lt;result&gt;

Called by the harness for each line of TAP it receives.

=head3 C&lt;close_test&gt;

Called to close a test session.

=head3 C&lt;clear_for_close&gt;

Called by C&lt;close_test&gt; to clear the line showing test progress, or the parallel
test ruler, prior to printing the final test result.

=head3 C&lt;time_report&gt;

Return a formatted string about the elapsed (wall-clock) time
and about the consumed CPU time.

=cut

sub header { }

sub result { }

sub close_test { }

sub clear_for_close { }

sub _should_show_count {
    my $self = shift;
    return
         !$self-&gt;formatter-&gt;verbose
      &amp;&amp; -t $self-&gt;formatter-&gt;stdout
      &amp;&amp; !$ENV{HARNESS_NOTTY};
}

sub _format_for_output {
    my ( $self, $result ) = @_;
    return $self-&gt;formatter-&gt;normalize ? $result-&gt;as_string : $result-&gt;raw;
}

sub _output_test_failure {
    my ( $self, $parser ) = @_;
    my $formatter = $self-&gt;formatter;
    return if $formatter-&gt;really_quiet;

    my $tests_run     = $parser-&gt;tests_run;
    my $tests_planned = $parser-&gt;tests_planned;

    my $total
      = defined $tests_planned
      ? $tests_planned
      : $tests_run;

    my $passed = $parser-&gt;passed;

    # The total number of fails includes any tests that were planned but
    # didn't run
    my $failed = $parser-&gt;failed + $total - $tests_run;
    my $exit   = $parser-&gt;exit;

    if ( my $exit = $parser-&gt;exit ) {
        my $wstat = $parser-&gt;wait;
        my $status = sprintf( "%d (wstat %d, 0x%x)", $exit, $wstat, $wstat );
        $formatter-&gt;_failure_output("Dubious, test returned $status\n");
    }

    if ( $failed == 0 ) {
        $formatter-&gt;_failure_output(
            $total
            ? "All $total subtests passed "
            : 'No subtests run '
        );
    }
    else {
        $formatter-&gt;_failure_output("Failed $failed/$total subtests ");
        if ( !$total ) {
            $formatter-&gt;_failure_output("\nNo tests run!");
        }
    }

    if ( my $skipped = $parser-&gt;skipped ) {
        $passed -= $skipped;
        my $test = 'subtest' . ( $skipped != 1 ? 's' : '' );
        $formatter-&gt;_output(
            "\n\t(less $skipped skipped $test: $passed okay)");
    }

    if ( my $failed = $parser-&gt;todo_passed ) {
        my $test = $failed &gt; 1 ? 'tests' : 'test';
        $formatter-&gt;_output(
            "\n\t($failed TODO $test unexpectedly succeeded)");
    }

    $formatter-&gt;_output("\n");
}

sub _make_ok_line {
    my ( $self, $suffix ) = @_;
    return "ok$suffix\n";
}

sub time_report {
    my ( $self, $formatter, $parser ) = @_;

    my @time_report;
    if ( $formatter-&gt;timer ) {
        my $start_time = $parser-&gt;start_time;
        my $end_time   = $parser-&gt;end_time;
        if ( defined $start_time and defined $end_time ) {
            my $elapsed = $end_time - $start_time;
            push @time_report,
              $self-&gt;time_is_hires
                ? sprintf( ' %8d ms', $elapsed * 1000 )
                : sprintf( ' %8s s', $elapsed || '&lt;1' );
        }
        my $start_times = $parser-&gt;start_times();
        my $end_times   = $parser-&gt;end_times();
        my $usr  = $end_times-&gt;[0] - $start_times-&gt;[0];
        my $sys  = $end_times-&gt;[1] - $start_times-&gt;[1];
        my $cusr = $end_times-&gt;[2] - $start_times-&gt;[2];
        my $csys = $end_times-&gt;[3] - $start_times-&gt;[3];
        push @time_report,
          sprintf('(%5.2f usr %5.2f sys + %5.2f cusr %5.2f csys = %5.2f CPU)',
                  $usr, $sys, $cusr, $csys,
                  $usr + $sys + $cusr + $csys);
    }

    return "@time_report";
}

1;
</pre></body></html>