Gecko [ fernandoquevedodop.com ]

Name	Size	Permission
Assertion	[ DIR ]	drwxr-xr-x
Runner	[ DIR ]	drwxr-xr-x
Assert.pm	20.71 KB	-rw-r--r--
Assertion.pm	1.98 KB	-rw-r--r--
Debug.pm	1.78 KB	-rw-r--r--
Decorator.pm	1.34 KB	-rw-r--r--
Error.pm	1.23 KB	-rw-r--r--
Exception.pm	1.75 KB	-rw-r--r--
Failure.pm	868 B	-rw-r--r--
HarnessUnit.pm	2.86 KB	-rw-r--r--
Listener.pm	2.01 KB	-rw-r--r--
Loader.pm	5.34 KB	-rw-r--r--
Procedural.pm	5.75 KB	-rw-r--r--
Result.pm	5.42 KB	-rw-r--r--
Runner.pm	1.93 KB	-rw-r--r--
Setup.pm	1.3 KB	-rw-r--r--
Test.pm	3.09 KB	-rw-r--r--
TestCase.pm	11.27 KB	-rw-r--r--
TestRunner.pm	5.64 KB	-rw-r--r--
TestSuite.pm	8.22 KB	-rw-r--r--
TkTestRunner.pm	18.07 KB	-rw-r--r--
Tutorial.pm	1.19 KB	-rw-r--r--
UnitHarness.pm	5.25 KB	-rw-r--r--
Warning.pm	783 B	-rw-r--r--

Code Editor : TestRunner.pm

package Test::Unit::TestRunner;
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 Benchmark;

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) = @_;
    $self->_print("E");
}
	
sub add_failure {
    my $self = shift;
    my ($test, $exception) = @_;
    $self->_print("F");
}

sub add_pass {
    # in this runner passes are ignored.
}

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()) {
        $self->_print("\n", "OK", " (", $result->run_count(), " tests)\n");
    } else {
        $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);
}

sub start_test {
    my $self = shift;
    my ($test) = @_;
    $self->_print(".");
}

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).

=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

${this.title}

Code Editor : TestRunner.pm