File Coverage

blib/lib/Test/Unit/HarnessUnit.pm
Criterion Covered Total %
statement 44 64 68.7
branch 2 6 33.3
condition n/a
subroutine 13 19 68.4
pod 0 13 0.0
total 59 102 57.8


line stmt bran cond sub pod time code
1             package Test::Unit::HarnessUnit;
2             BEGIN {
3 2     2   1165 $Test::Unit::HarnessUnit::VERSION = '0.25_1325'; # added by dist-tools/SetVersion.pl
4             }
5             # this is a test runner which outputs in the same
6             # format that Test::Harness expects.
7 2     2   14 use strict;
  2         4  
  2         60  
8              
9 2     2   10 use base qw(Test::Unit::Runner);
  2         3  
  2         1037  
10              
11 2     2   13 use Test::Unit::TestSuite;
  2         4  
  2         47  
12 2     2   12 use Test::Unit::Loader;
  2         3  
  2         1614  
13              
14             sub new {
15 2     2 0 25 my $class = shift;
16 2         6 my ($filehandle) = @_;
17             # should really use the IO::Handle package here.
18             # this is very ugly.
19 2 50       8 $filehandle = \*STDOUT unless $filehandle;
20 2         11 bless { _Print_stream => $filehandle }, $class;
21             }
22              
23             sub print_stream {
24 0     0 0 0 my $self = shift;
25 0         0 return $self->{_Print_stream};
26             }
27              
28             sub _print {
29 92     92   185 my $self = shift;
30 92         205 my (@args) = @_;
31 92         651 $self->{_Print_stream}->print( @args);
32             }
33              
34             sub start_test {
35 90     90 0 123 my $self=shift;
36 90         347 my $test=shift;
37             }
38              
39             sub not_ok {
40 0     0 0 0 my $self = shift;
41 0         0 my ($test, $exception) = @_;
42 0         0 $self->_print("\nnot ok ERROR ",
43             $test->name(),
44             "\n$exception\n");
45             }
46              
47             sub ok {
48 90     90 0 116 my $self = shift;
49 90         137 my ($test) = @_;
50 90         369 $self->_print("ok PASS " . $test->name() . "\n");
51             }
52              
53             sub add_error {
54 0     0 0 0 my $self = shift;
55 0         0 $self->not_ok(@_);
56             }
57            
58             sub add_failure {
59 0     0 0 0 my $self = shift;
60 0         0 $self->not_ok(@_);
61             }
62              
63             sub add_pass {
64 90     90 0 161 my $self = shift;
65 90         315 $self->ok(@_);
66             }
67              
68             sub end_test {
69 90     90 0 193 my $self = shift;
70 90         500 my ($test) = @_;
71             }
72              
73             sub do_run {
74 2     2 0 5 my $self = shift;
75 2         3 my ($suite) = @_;
76 2         19 my $result = $self->create_test_result();
77 2         13 $result->add_listener($self);
78 2         11 $suite->run($result, $self);
79             }
80              
81             sub main {
82 0     0 0 0 my $self = shift;
83 0         0 my $a_test_runner = __PACKAGE__->new;
84 0         0 $a_test_runner->start(@_);
85             }
86              
87             sub run {
88 0     0 0 0 my $self = shift;
89 0         0 my ($class) = @_;
90 0         0 my $a_test_runner = Test::Unit::TestRunner->new();
91 0 0       0 if ($class->isa("Test::Unit::Test")) {
92 0         0 $a_test_runner->do_run($class, 0);
93             } else {
94 0         0 $a_test_runner->do_run(Test::Unit::TestSuite->new($class), 0);
95             }
96             }
97              
98             sub start {
99 2     2 0 12 my $self = shift;
100 2         6 my (@args) = @_;
101              
102 2         4 my $test_case = "";
103 2         5 my $wait = 0;
104 2         15 my $suite = Test::Unit::Loader::load(@args);
105 2 50       10 if ($suite) {
106 2         9 my $count=$suite->count_test_cases();
107 2         17 $self->_print("STARTING TEST RUN\n1..$count\n");
108 2         50 $self->do_run($suite);
109 2         21 exit(0);
110             } else {
111 0           $self->_print("Invalid argument to test runner: $args[0]\n");
112 0           exit(1);
113             }
114             }
115              
116             1;
117             __END__