291 lines
6.0 KiB
Perl
291 lines
6.0 KiB
Perl
##
|
|
## We use our own Runner class for better reporting and exit status
|
|
## that works with Hudson.
|
|
##
|
|
##
|
|
|
|
package RQGRunner;
|
|
use strict;
|
|
|
|
use base qw(Test::Unit::Runner);
|
|
|
|
use Test::Unit; # for copyright & version number
|
|
use Test::Unit::TestSuite;
|
|
use Test::Unit::Loader;
|
|
use Test::Unit::Result;
|
|
|
|
use Data::Dumper;
|
|
|
|
use Benchmark;
|
|
|
|
my $exit_code = 0;
|
|
|
|
sub new {
|
|
my $class = shift;
|
|
my ($filehandle) = @_;
|
|
$filehandle = \*STDOUT unless $filehandle;
|
|
select((select($filehandle), $| = 1)[0]);
|
|
bless { _Print_stream => $filehandle }, $class;
|
|
}
|
|
|
|
sub print_stream {
|
|
my $self = shift;
|
|
return $self->{_Print_stream};
|
|
}
|
|
|
|
sub _print {
|
|
my $self = shift;
|
|
my (@args) = @_;
|
|
$self->print_stream->print(@args);
|
|
}
|
|
|
|
sub add_error {
|
|
my $self = shift;
|
|
my ($test, $exception) = @_;
|
|
my $tn = ref $test;
|
|
$self->_print("Error: ".$tn."::".$test->name()."\n");
|
|
}
|
|
|
|
sub add_failure {
|
|
my $self = shift;
|
|
my ($test, $exception) = @_;
|
|
my $tn = ref $test;
|
|
$self->_print("Failure: ".$tn."::".$test->name()."\n");
|
|
}
|
|
|
|
sub add_pass {
|
|
my $self = shift;
|
|
my ($test, $exception) = @_; my $tn = ref $test;
|
|
my $tn = ref $test;
|
|
$self->_print("Success: ".$tn."::".$test->name()."\n");
|
|
}
|
|
|
|
sub do_run {
|
|
my $self = shift;
|
|
my ($suite, $wait) = @_;
|
|
my $result = $self->create_test_result();
|
|
$result->add_listener($self);
|
|
my $start_time = new Benchmark();
|
|
$suite->run($result, $self);
|
|
my $end_time = new Benchmark();
|
|
|
|
$self->print_result($result, $start_time, $end_time);
|
|
|
|
if ($wait) {
|
|
print "<RETURN> to continue"; # go to STDIN any case
|
|
<STDIN>;
|
|
}
|
|
|
|
$self->_print("\nTest was not successful.\n")
|
|
unless $result->was_successful;
|
|
|
|
return $result->was_successful;
|
|
}
|
|
|
|
sub end_test {
|
|
}
|
|
|
|
sub main {
|
|
my $self = shift;
|
|
my $a_test_runner = Test::Unit::TestRunner->new();
|
|
$a_test_runner->start(@_);
|
|
}
|
|
|
|
sub print_result {
|
|
my $self = shift;
|
|
my ($result, $start_time, $end_time) = @_;
|
|
|
|
my $run_time = timediff($end_time, $start_time);
|
|
$self->_print("\n", "Time: ", timestr($run_time), "\n");
|
|
|
|
$self->print_header($result);
|
|
$self->print_errors($result);
|
|
$self->print_failures($result);
|
|
}
|
|
|
|
sub print_errors {
|
|
my $self = shift;
|
|
my ($result) = @_;
|
|
return unless my $error_count = $result->error_count();
|
|
my $msg = "\nThere " .
|
|
($error_count == 1 ?
|
|
"was 1 error"
|
|
: "were $error_count errors") .
|
|
":\n";
|
|
$self->_print($msg);
|
|
|
|
my $i = 0;
|
|
for my $e (@{$result->errors()}) {
|
|
chomp(my $e_to_str = $e);
|
|
$i++;
|
|
$self->_print("$i) $e_to_str\n");
|
|
$self->_print("\nAnnotations:\n", $e->object->annotations())
|
|
if $e->object->annotations();
|
|
}
|
|
}
|
|
|
|
sub print_failures {
|
|
my $self = shift;
|
|
my ($result) = @_;
|
|
return unless my $failure_count = $result->failure_count;
|
|
my $msg = "\nThere " .
|
|
($failure_count == 1 ?
|
|
"was 1 failure"
|
|
: "were $failure_count failures") .
|
|
":\n";
|
|
$self->_print($msg);
|
|
|
|
my $i = 0;
|
|
for my $f (@{$result->failures()}) {
|
|
chomp(my $f_to_str = $f);
|
|
$self->_print("\n") if $i++;
|
|
$self->_print("$i) $f_to_str\n");
|
|
$self->_print("\nAnnotations:\n", $f->object->annotations())
|
|
if $f->object->annotations();
|
|
}
|
|
}
|
|
|
|
sub print_header {
|
|
my $self = shift;
|
|
my ($result) = @_;
|
|
if ($result->was_successful()) {
|
|
$exit_code = 0;
|
|
$self->_print("\n", "OK", " (", $result->run_count(), " tests)\n");
|
|
} else {
|
|
$exit_code = 1;
|
|
$self->_print("\n", "!!!FAILURES!!!", "\n",
|
|
"Test Results:\n",
|
|
"Run: ", $result->run_count(),
|
|
", Failures: ", $result->failure_count(),
|
|
", Errors: ", $result->error_count(),
|
|
"\n");
|
|
}
|
|
}
|
|
|
|
sub run {
|
|
my $self = shift;
|
|
my ($class) = @_;
|
|
my $a_test_runner = Test::Unit::TestRunner->new();
|
|
$a_test_runner->do_run(Test::Unit::TestSuite->new($class), 0);
|
|
}
|
|
|
|
sub run_and_wait {
|
|
my $self = shift;
|
|
my ($test) = @_;
|
|
my $a_test_runner = Test::Unit::TestRunner->new();
|
|
$a_test_runner->do_run(Test::Unit::TestSuite->new($test), 1);
|
|
}
|
|
|
|
sub start {
|
|
my $self = shift;
|
|
my (@args) = @_;
|
|
|
|
my $test = "";
|
|
my $wait = 0;
|
|
|
|
for (my $i = 0; $i < @args; $i++) {
|
|
if ($args[$i] eq "-wait") {
|
|
$wait = 1;
|
|
} elsif ($args[$i] eq "-v") {
|
|
print Test::Unit::COPYRIGHT_SHORT;
|
|
} else {
|
|
$test = $args[$i];
|
|
}
|
|
}
|
|
if ($test eq "") {
|
|
die "Usage: TestRunner.pl [-wait] name, where name is the name of the Test class\n";
|
|
}
|
|
|
|
my $suite = Test::Unit::Loader::load($test);
|
|
$self->do_run($suite, $wait);
|
|
return $exit_code;
|
|
}
|
|
|
|
sub start_test {
|
|
my $self = shift;
|
|
my ($test) = @_;
|
|
}
|
|
|
|
1;
|
|
__END__
|
|
|
|
|
|
=head1 NAME
|
|
|
|
Test::Unit::TestRunner - unit testing framework helper class
|
|
|
|
=head1 SYNOPSIS
|
|
|
|
use Test::Unit::TestRunner;
|
|
|
|
my $testrunner = Test::Unit::TestRunner->new();
|
|
$testrunner->start($my_test_class);
|
|
|
|
=head1 DESCRIPTION
|
|
|
|
This class is the test runner for the command line style use
|
|
of the testing framework.
|
|
|
|
It is used by simple command line tools like the F<TestRunner.pl>
|
|
script provided.
|
|
|
|
The class needs one argument, which is the name of the class
|
|
encapsulating the tests to be run.
|
|
|
|
=head1 OPTIONS
|
|
|
|
=over 4
|
|
|
|
=item -wait
|
|
|
|
wait for user confirmation between tests
|
|
|
|
=item -v
|
|
|
|
version info
|
|
|
|
=back
|
|
|
|
|
|
=head1 AUTHOR
|
|
|
|
Copyright (c) 2000-2002, 2005 the PerlUnit Development Team
|
|
(see L<Test::Unit> or the F<AUTHORS> file included in this
|
|
distribution).
|
|
|
|
All rights reserved. This program is free software; you can
|
|
redistribute it and/or modify it under the same terms as Perl itself.
|
|
|
|
=head1 SEE ALSO
|
|
|
|
=over 4
|
|
|
|
=item *
|
|
|
|
L<Test::Unit::TestCase>
|
|
|
|
=item *
|
|
|
|
L<Test::Unit::Listener>
|
|
|
|
=item *
|
|
|
|
L<Test::Unit::TestSuite>
|
|
|
|
=item *
|
|
|
|
L<Test::Unit::Result>
|
|
|
|
=item *
|
|
|
|
L<Test::Unit::TkTestRunner>
|
|
|
|
=item *
|
|
|
|
For further examples, take a look at the framework self test
|
|
collection (t::tlib::AllTests).
|
|
|
|
=back
|
|
|
|
=cut
|