/usr/share/perl5/Test/Unit/HarnessUnit.pm is in libtest-unit-perl 0.25-2.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 | package Test::Unit::HarnessUnit;
# this is a test runner which outputs in the same
# format that Test::Harness expects.
use strict;
use base qw(Test::Unit::Runner);
use Test::Unit::TestSuite;
use Test::Unit::Loader;
sub new {
my $class = shift;
my ($filehandle) = @_;
# should really use the IO::Handle package here.
# this is very ugly.
$filehandle = \*STDOUT unless $filehandle;
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 start_test {
my $self=shift;
my $test=shift;
}
sub not_ok {
my $self = shift;
my ($test, $exception) = @_;
$self->_print("\nnot ok ERROR ",
$test->name(),
"\n$exception\n");
}
sub ok {
my $self = shift;
my ($test) = @_;
$self->_print("ok PASS " . $test->name() . "\n");
}
sub add_error {
my $self = shift;
$self->not_ok(@_);
}
sub add_failure {
my $self = shift;
$self->not_ok(@_);
}
sub add_pass {
my $self = shift;
$self->ok(@_);
}
sub end_test {
my $self = shift;
my ($test) = @_;
}
sub do_run {
my $self = shift;
my ($suite) = @_;
my $result = $self->create_test_result();
$result->add_listener($self);
$suite->run($result, $self);
}
sub main {
my $self = shift;
my $a_test_runner = __PACKAGE__->new;
$a_test_runner->start(@_);
}
sub run {
my $self = shift;
my ($class) = @_;
my $a_test_runner = Test::Unit::TestRunner->new();
if ($class->isa("Test::Unit::Test")) {
$a_test_runner->do_run($class, 0);
} else {
$a_test_runner->do_run(Test::Unit::TestSuite->new($class), 0);
}
}
sub start {
my $self = shift;
my (@args) = @_;
my $test_case = "";
my $wait = 0;
my $suite = Test::Unit::Loader::load(@args);
if ($suite) {
my $count=$suite->count_test_cases();
$self->_print("STARTING TEST RUN\n1..$count\n");
$self->do_run($suite);
exit(0);
} else {
$self->_print("Invalid argument to test runner: $args[0]\n");
exit(1);
}
}
1;
__END__
=head1 NAME
Test::Unit::HarnessUnit - unit testing framework helper class
=head1 SYNOPSIS
This class is not intended to be used directly
=head1 DESCRIPTION
This is a test runner which outputs in the same format that
Test::Harness expects.
=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::UnitHarness>
=item *
L<Test::Unit::TestRunner>
=item *
L<Test::Unit::TkTestRunner>
=back
=cut
|