view release on metacpan or  search on metacpan

lib/TAP/Formatter/JUnitREGRU/Session.pm  view on Meta::CPAN

}

###############################################################################
# Subroutine:   close_test()
###############################################################################
# Called to close the test session.
#
# Flushes the queue if we've got anything left in it, dumps the JUnit to disk
# (if necessary), and adds the XML for this test suite to our formatter.
sub close_test {
    my $self   = shift;
    my $xml    = $self->xml;
    my $parser = $self->parser;

    # Process the queued up TAP stream
    my $is_first      = 1;
    my $t_start       = $self->parser->start_time;
    my $t_last_test   = $t_start;
    my $timer_enabled = $self->formatter->timer;

    my $queue = $self->_queue;
    my $index = 0;
    while ($index < @{$queue}) {
        my $result = $queue->[$index++];

        # First line of output generates the "init" timing.
        if ($is_first) {
            if ($timer_enabled) {
                unless ($result->is_test) {
                    my $duration = $result->time - $t_start;
                    my $case     = $xml->testcase( {
                        'name' => _squeaky_clean('(init)'),
                        'time' => $duration,
                    } );
                    $self->add_testcase($case);
                    $t_last_test = $result->time;
                }
            }
            $is_first = 0;
        }

        # Test output
        if ($result->is_test) {
            # how long did it take for this test?
            my $duration = $result->time - $t_last_test;

            # slurp in all of the content up until the next test
            my $content = $result->as_string;
            while ($index < @{$queue}) {
                last if ($queue->[$index]->is_test);
                last if ($queue->[$index]->is_plan);

                my $stuff = $queue->[$index++];
                $content .= "\n" . $stuff->as_string;
            }

            # create a failure/error element if the test was bogus
            my $failure;
            my $bogosity = $self->_check_for_test_bogosity($result);
            if ($bogosity) {
                my $cdata = $self->_cdata($content);
                my $level = $bogosity->{level};
                $failure  = $xml->$level( {
                    type    => $bogosity->{type},
                    message => $bogosity->{message},
                }, $cdata );
            }

            # add this test to the XML stream
            my $case = $xml->testcase(
                {
                    'name' => _get_testcase_name($result),
                    (
                        $timer_enabled ? ('time' => $duration) : ()
                    ),
                },
                $failure,
            );
            $self->add_testcase($case);

            # update time of last test seen
            $t_last_test = $result->time;
        }
    }

    # track time for teardown, if needed
    if ($timer_enabled && @{$queue}) {
        my $duration = $self->parser->end_time - $queue->[-1]->time;
        my $case     = $xml->testcase( {
            'name' => _squeaky_clean('(teardown)'),
            'time' => $duration,
        } );
        $self->add_testcase($case);
    }

    # collect up all of the captured test output
    my $captured = join '', map { $_->raw . "\n" } @{$queue};

    # if the test died unexpectedly, make note of that
    my $die_msg;
    my $exit = $parser->exit();
    if ($exit) {
        my $wstat = $parser->wait();
        my $status = sprintf("%d (wstat %d, 0x%x)", $exit, $wstat, $wstat);
        $die_msg  = "Dubious, test returned $status";
    }

    # add system-out/system-err data, as raw CDATA
    my $sys_out = 'system-out';
    $sys_out = $xml->$sys_out($captured ? $self->_cdata($captured) : undef);

    my $sys_err = 'system-err';
    $sys_err = $xml->$sys_err($die_msg ? $self->_cdata("$die_msg\n") : undef);

    # update the testsuite with aggregate info on this test suite
    #
    # tests     - total number of tests run
    # time      - wallclock time taken for test run (floating point)
    # failures  - number of tests that we detected as failing
    # errors    - number of errors:
    #               - passing TODOs
    #               - if a plan was provided, mismatch between that and the
    #                 number of actual tests that were run
    #               - either "no plan was issued" or "test died" (a dying test
    #                 may not have a plan issued, but should still be considered
    #                 a single error condition)
    my $testsrun = $parser->tests_run() || 0;
    my $time     = $parser->end_time() - $parser->start_time();
    my $failures = $parser->failed();

    my $noplan   = $parser->plan() ? 0 : 1;
    my $planned  = $parser->tests_planned() || 0;

    my $num_errors = 0;
    $num_errors += $parser->todo_passed() unless $self->passing_todo_ok();
    $num_errors += abs($testsrun - $planned) if ($planned);

    my $suite_err;
    if ($die_msg) {
        $suite_err = $xml->error( { message => $die_msg } );
        $num_errors ++;
    }
    elsif ($noplan) {
        $suite_err = $xml->error( { message => 'No plan in TAP output' } );
        $num_errors ++;
    }
    elsif ($planned && ($testsrun != $planned)) {
        $suite_err = $xml->error( { message => "Looks like you planned $planned tests but ran $testsrun." } );
    }

    my @tests = @{$self->testcases()};
    my %attrs = (
        'name'     => _get_testsuite_name($self),
        'tests'    => $testsrun,
        'failures' => $failures,
        'errors'   => $num_errors,
        (
            $timer_enabled ? ('time' => $time) : ()
        ),
    );
    my $testsuite = $xml->testsuite(\%attrs, @tests, $sys_out, $sys_err, $suite_err);
    $self->formatter->add_testsuite($testsuite);
    $self->dump_junit_xml($testsuite);
}

###############################################################################
# Subroutine:   dump_junit_xml($testsuite)
###############################################################################
# Dumps the JUnit for the given XML '$testsuite', to the directory specified by
# 'PERL_TEST_HARNESS_DUMP_TAP'.
sub dump_junit_xml {
    my ($self, $testsuite) = @_;
    if (my $spool_dir = $ENV{PERL_TEST_HARNESS_DUMP_TAP}) {

lib/TAP/Formatter/JUnitREGRU/Session.pm  view on Meta::CPAN

    }

    if ($result->is_unplanned()) {
        return {
            level   => 'error',
            type    => 'UnplannedTest',
            message => $result->as_string(),
        };
    }

    if (not $result->is_ok()) {
        return {
            level   => 'failure',
            type    => 'TestFailed',
            message => $result->as_string(),
        };
    }

    return;
}

###############################################################################
# Generates the name for a test case.
sub _get_testcase_name {
    my $test = shift;
    my $name = join(' ', $test->number(), _clean_test_description($test));
    $name =~ s/\s+$//;
    return $name;
}

###############################################################################
# Generates the name for the entire test suite.
sub _get_testsuite_name {
    my $self = shift;
    my $name = $self->name;
    $name =~ s{^\./}{};
    $name =~ s{^t/}{};
    return _clean_to_java_class_name($name);
}

###############################################################################
# Cleans up the given string, removing any characters that aren't suitable for
# use in a Java class name.
sub _clean_to_java_class_name {
    my $str = shift;
    $str =~ s/[^-:_A-Za-z0-9]+/_/gs;
    return $str;
}

###############################################################################
# Cleans up the description of the given test.
sub _clean_test_description {
    my $test = shift;
    my $desc = $test->description();
    return _squeaky_clean($desc);
}

###############################################################################
# Creates a CDATA block for the given data (which is made squeaky clean first,
# so that JUnit parsers like Hudson's don't choke).
sub _cdata {
    my ($self, $data) = @_;
    $data = _squeaky_clean($data);
    return $self->xml->xmlcdata($data);
}

###############################################################################
# Clean a string to the point that JUnit can't possibly have a problem with it.
sub _squeaky_clean {
    my $string = shift;
    # control characters (except CR and LF)
    $string =~ s/([\x00-\x09\x0b\x0c\x0e-\x1f])/"^".chr(ord($1)+64)/ge;
    return $string;
}

1;

=head1 NAME

TAP::Formatter::JUnitREGRU::Session - Harness output delegate for JUnit output

=head1 DESCRIPTION

C<TAP::Formatter::JUnitREGRU::Session> provides JUnit output formatting for
C<TAP::Harness>.

=head1 METHODS

=over

=item B<_initialize($arg_for)>

Over-ridden private initializer, so we can accept a new "passing_todo_ok"
argument at instantiation time.

=item B<result($result)>

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

Internally, all of the TAP is added to a queue until we hit the start of
the "next" test (at which point we flush the queue. This allows us to
capture any error output or diagnostic info that comes after a test
failure.

=item B<close_test()>

Called to close the test session.

Flushes the queue if we've got anything left in it, dumps the JUnit to disk
(if necessary), and adds the XML for this test suite to our formatter.

=item B<dump_junit_xml($testsuite)>

Dumps the JUnit for the given XML C<$testsuite>, to the directory specified
by C<PERL_TEST_HARNESS_DUMP_TAP>.

=item B<add_testcase($case)>

Adds an XML test C<$case> to the list of testcases we've run in this
session.

=item B<xml()>

Returns a new C<XML::Generator> to generate XML output. This is simply a