| PANT documentation | Contained in the PANT distribution. |
PANT::Test - PANT support for running tests
use PANT::Test; $tester = new PANT::Test($xmlwriter); $tester->runtests(tests=>[@testlist], directory=>"test");
This is part of a module to help construct automated build environments. This part is for running tests.
This module is part of a set to help run automated builds of a project and to produce a build log. This part is designed to incorporate runs of the perl test suite.
None
Constructor for a test object. Requires an XML::Writer object as a parameter, which it will use for subsequent log construction.
This takes a list of files with tests in to run. The output is trapped and diverted to the logging stream. It appears as an html table. Table cells that refer to a failed test will have the html ID of "fail", and those that pass will be tagged with the ID "pass". This allows for appropriate syle sheet controls to highlight cells.
td#fail { background:red }
td#pass { background:green }
It takes the following options
The list of tests to run (.t files).
An optional directory to change to for the duration of the test
Makes use of XML::Writer to construct the build log.
Julian Onions, <julianonions@yahoo.nospam-co.uk>
Copyright 2005 by Julian Onions
This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
| PANT documentation | Contained in the PANT distribution. |
# PANT::Test - Test modules from PANT package PANT::Test; use 5.008; use strict; use warnings; use Carp; use Cwd; use XML::Writer; use Test::Harness::Straps; use Benchmark; use Exporter; our @ISA = qw(Exporter); # Items to export into callers namespace by default. Note: do not export # names by default without a very good reason. Use EXPORT_OK instead. # Do not simply export all your public functions/methods/constants. # This allows declaration use PANT ':all'; # If you do not need this, moving things directly into @EXPORT or @EXPORT_OK # will save memory. our %EXPORT_TAGS = ( 'all' => [ qw() ] ); our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } ); our @EXPORT = qw( ); our $VERSION = '0.15'; sub new { my($clsname, $writer, @args) =@_; my $self = { writer=>$writer, @args }; bless $self, $clsname; return $self; } sub RunTests { my($self, %args) = @_; my $writer = $self->{writer}; my $dir = $args{directory}; my $pushstreams = 1; my $cdir; if ($dir) { $cdir = getcwd; chdir($dir) || Abort("Can't change to directory $dir"); } my $retval = 1; $writer->dataElement('h2', "Run the following tests"); $writer->startTag('ul'); $writer->startTag('table', border=>1); $writer->startTag('tr'); foreach my $h (("Test", "No.", "Passed", "Failed", "Skipped", "Pass rate", "Failure reason")) { $writer->dataElement('th', $h); } $writer->endTag('tr'); my $stderrfile = "xxxxstderr$$.txt"; my($OLDERR, $stderr); if ($pushstreams) { # push the output state open $OLDERR, ">&", \*STDERR or die "Can't dup STDERR: $!"; $stderr = ""; close(STDERR); open(STDERR, ">$stderrfile") or die "Can't open STDERR: $!"; } my $totaltests = 0; my $totalpass = 0; my $tfiles = 0; my $tfailures = 0; my $strap = new Test::Harness::Straps; my $t_start = new Benchmark; foreach my $tfile (@{$args{tests}}) { $writer->startTag('tr'); $writer->dataElement('td', $tfile); $tfiles ++; my %results; if (!$self->{dryrun}) { %results = $strap->analyze_file($tfile); } if (!%results) { $writer->dataElement('td', $self->{dryrun} ? "Test not run -dryrun" : $strap->{error}); $writer->endTag('tr'); $totaltests ++; next; }; $tfailures ++ if (!$results{passing}); $totalpass += $results{ok}; $totaltests += $results{max}; my %attr = (id=> ($results{passing} ? "pass" : "fail")); $writer->dataElement('td', $results{max}, %attr); $writer->dataElement('td', $results{ok}, %attr); $writer->dataElement('td', $results{max} - $results{ok}, %attr); $writer->dataElement('td', $results{skip}, %attr); $writer->dataElement('td', sprintf("%.2f", $results{ok} / $results{max} * 100), %attr); $writer->startTag('td', %attr); foreach my $err (MakeFailureReport(\%results)) { $writer->characters($err); $writer->emptyTag('br'); } $writer->endTag('td'); $writer->endTag('tr'); } my $timed = timediff(new Benchmark, $t_start); if ($pushstreams) { open STDERR, ">&", $OLDERR or die "Can't dup OLDERR: $!"; if (open JUNK, "$stderrfile") { local($/); $stderr = <JUNK>; close(JUNK); } unlink($stderrfile); } $writer->endTag("table"); $writer->dataElement('li', sprintf("Summary: Test Files $tfiles, Failed Test files $tfailures, %.2f%%", ($tfiles-$tfailures) / $tfiles * 100)); $writer->dataElement('li', sprintf("Summary: Total Tests $totaltests, Failed Tests %d, Pass rate %.2f%%", $totaltests - $totalpass, $totalpass / $totaltests * 100)); $writer->dataElement('li', "Took " . timestr($timed)); if($stderr) { $writer->dataElement('li', "Error output"); $writer->dataElement('pre', $stderr); } chdir ($cdir) if ($cdir); $writer->endTag('ul'); return $retval; } sub MakeFailureReport { my $report = shift; return ("All Passed") if ($report->{passing}); my @results = (); my $tnum = 0; foreach my $test (@{$report->{details}}) { $tnum ++; next if ($test->{ok}); push(@results, "$tnum $test->{name}"); } return @results; } 1; __END__