File Coverage

blib/lib/Test/Unit/TestRunner.pm
Criterion Covered Total %
statement 87 115 75.6
branch 16 28 57.1
condition n/a
subroutine 20 24 83.3
pod 0 16 0.0
total 123 183 67.2


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