PANT::Test - PANT support for running tests


PANT documentation Contained in the PANT distribution.

Index


Code Index:

NAME

Top

PANT::Test - PANT support for running tests

SYNOPSIS

Top

  use PANT::Test;

  $tester = new PANT::Test($xmlwriter);
  $tester->runtests(tests=>[@testlist], directory=>"test");

ABSTRACT

Top

  This is part of a module to help construct automated build environments.
  This part is for running tests.

DESCRIPTION

Top

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.

EXPORTS

Top

None

METHODS

Top

new

Constructor for a test object. Requires an XML::Writer object as a parameter, which it will use for subsequent log construction.

runtests

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

tests=>[list of tests]

The list of tests to run (.t files).

directory=>somewhere

An optional directory to change to for the duration of the test

SEE ALSO

Top

Makes use of XML::Writer to construct the build log.

AUTHOR

Top

Julian Onions, <julianonions@yahoo.nospam-co.uk>

COPYRIGHT AND LICENSE

Top


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__