File Coverage

blib/lib/Test/Unit/TestRunner.pm
Criterion Covered Total %
statement 88 116 75.8
branch 16 28 57.1
condition n/a
subroutine 21 25 84.0
pod 0 16 0.0
total 125 185 67.5


line stmt bran cond sub pod time code
1             package Test::Unit::TestRunner;
2             BEGIN {
3 1     1   669 $Test::Unit::TestRunner::VERSION = '0.25_1325'; # added by dist-tools/SetVersion.pl
4             }
5 1     1   6 use strict;
  1         2  
  1         26  
6              
7 1     1   5 use base qw(Test::Unit::Runner);
  1         1  
  1         69  
8              
9 1     1   536 use Test::Unit; # for copyright & version number
  1         4  
  1         26  
10 1     1   7 use Test::Unit::TestSuite;
  1         1  
  1         21  
11 1     1   6 use Test::Unit::Loader;
  1         1  
  1         19  
12 1     1   4 use Test::Unit::Result;
  1         2  
  1         17  
13              
14 1     1   988 use Benchmark;
  1         8456  
  1         9  
15              
16             sub new {
17 7     7 0 392 my $class = shift;
18 7         13 my ($filehandle) = @_;
19 7 100       30 $filehandle = \*STDOUT unless $filehandle;
20 7         2823 select((select($filehandle), $| = 1)[0]);
21 7         57 bless { _Print_stream => $filehandle }, $class;
22             }
23              
24             sub print_stream {
25 36     36 0 37 my $self = shift;
26 36         142 return $self->{_Print_stream};
27             }
28              
29             sub _print {
30 36     36   355 my $self = shift;
31 36         79 my (@args) = @_;
32 36         68 $self->print_stream->print(@args);
33             }
34              
35             sub add_error {
36 6     6 0 9 my $self = shift;
37 6         10 my ($test, $exception) = @_;
38 6         31 $self->_print("E");
39             }
40            
41             sub add_failure {
42 0     0 0 0 my $self = shift;
43 0         0 my ($test, $exception) = @_;
44 0         0 $self->_print("F");
45             }
46              
47 4     4 0 24 sub add_pass {
48             # in this runner passes are ignored.
49             }
50              
51             sub do_run {
52 5     5 0 10 my $self = shift;
53 5         8 my ($suite, $wait) = @_;
54 5         37 my $result = $self->create_test_result();
55 5         24 $result->add_listener($self);
56 5         33 my $start_time = new Benchmark();
57 5         129 $suite->run($result, $self);
58 4         16 my $end_time = new Benchmark();
59            
60 4         78 $self->print_result($result, $start_time, $end_time);
61            
62 4 50       11 if ($wait) {
63 0         0 print " to continue"; # go to STDIN any case
64 0         0 ;
65             }
66              
67 4 100       13 $self->_print("\nTest was not successful.\n")
68             unless $result->was_successful;
69              
70 4         37 return $result->was_successful;
71             }
72              
73 10     10 0 41 sub end_test {
74             }
75              
76             sub main {
77 0     0 0 0 my $self = shift;
78 0         0 my $a_test_runner = Test::Unit::TestRunner->new();
79 0         0 $a_test_runner->start(@_);
80             }
81              
82             sub print_result {
83 4     4 0 7 my $self = shift;
84 4         11 my ($result, $start_time, $end_time) = @_;
85              
86 4         17 my $run_time = timediff($end_time, $start_time);
87 4         102 $self->_print("\n", "Time: ", timestr($run_time), "\n");
88              
89 4         51 $self->print_header($result);
90 4         67 $self->print_errors($result);
91 4         16 $self->print_failures($result);
92             }
93              
94             sub print_errors {
95 4     4 0 9 my $self = shift;
96 4         8 my ($result) = @_;
97 4 100       14 return unless my $error_count = $result->error_count();
98 3 100       15 my $msg = "\nThere " .
99             ($error_count == 1 ?
100             "was 1 error"
101             : "were $error_count errors") .
102             ":\n";
103 3         9 $self->_print($msg);
104              
105 3         23 my $i = 0;
106 3         5 for my $e (@{$result->errors()}) {
  3         9  
107 6         25 chomp(my $e_to_str = $e);
108 6         11 $i++;
109 6         20 $self->_print("$i) $e_to_str\n");
110 6 50       65 $self->_print("\nAnnotations:\n", $e->object->annotations())
111             if $e->object->annotations();
112             }
113             }
114              
115             sub print_failures {
116 4     4 0 8 my $self = shift;
117 4         6 my ($result) = @_;
118 4 50       13 return unless my $failure_count = $result->failure_count;
119 0 0       0 my $msg = "\nThere " .
120             ($failure_count == 1 ?
121             "was 1 failure"
122             : "were $failure_count failures") .
123             ":\n";
124 0         0 $self->_print($msg);
125              
126 0         0 my $i = 0;
127 0         0 for my $f (@{$result->failures()}) {
  0         0  
128 0         0 chomp(my $f_to_str = $f);
129 0 0       0 $self->_print("\n") if $i++;
130 0         0 $self->_print("$i) $f_to_str\n");
131 0 0       0 $self->_print("\nAnnotations:\n", $f->object->annotations())
132             if $f->object->annotations();
133             }
134             }
135              
136             sub print_header {
137 4     4 0 7 my $self = shift;
138 4         8 my ($result) = @_;
139 4 100       17 if ($result->was_successful()) {
140 1         6 $self->_print("\n", "OK", " (", $result->run_count(), " tests)\n");
141             } else {
142 3         15 $self->_print("\n", "!!!FAILURES!!!", "\n",
143             "Test Results:\n",
144             "Run: ", $result->run_count(),
145             ", Failures: ", $result->failure_count(),
146             ", Errors: ", $result->error_count(),
147             "\n");
148             }
149             }
150              
151             sub run {
152 0     0 0 0 my $self = shift;
153 0         0 my ($class) = @_;
154 0         0 my $a_test_runner = Test::Unit::TestRunner->new();
155 0         0 $a_test_runner->do_run(Test::Unit::TestSuite->new($class), 0);
156             }
157            
158             sub run_and_wait {
159 0     0 0 0 my $self = shift;
160 0         0 my ($test) = @_;
161 0         0 my $a_test_runner = Test::Unit::TestRunner->new();
162 0         0 $a_test_runner->do_run(Test::Unit::TestSuite->new($test), 1);
163             }
164              
165             sub start {
166 7     7 0 42 my $self = shift;
167 7         18 my (@args) = @_;
168              
169 7         11 my $test = "";
170 7         13 my $wait = 0;
171              
172 7         75 for (my $i = 0; $i < @args; $i++) {
173 7 50       39 if ($args[$i] eq "-wait") {
    50          
174 0         0 $wait = 1;
175             } elsif ($args[$i] eq "-v") {
176 0         0 print Test::Unit::COPYRIGHT_SHORT;
177             } else {
178 7         24 $test = $args[$i];
179             }
180             }
181 7 50       22 if ($test eq "") {
182 0         0 die "Usage: TestRunner.pl [-wait] name, where name is the name of the Test class\n";
183             }
184            
185 7         35 my $suite = Test::Unit::Loader::load($test);
186 5         30 $self->do_run($suite, $wait);
187             }
188              
189             sub start_test {
190 10     10 0 13 my $self = shift;
191 10         15 my ($test) = @_;
192 10         24 $self->_print(".");
193             }
194              
195             1;
196             __END__