view release on metacpan or  search on metacpan

lib/App/TestOnTap/Harness.pm  view on Meta::CPAN

package App::TestOnTap::Harness;

use strict;
use warnings;

our $VERSION = '1.001';
my $version = $VERSION;
$VERSION = eval $VERSION;

use base qw(TAP::Harness);

use App::TestOnTap::Scheduler;
use App::TestOnTap::Dispenser;
use App::TestOnTap::Util qw(slashify runprocess $IS_PACKED);

use TAP::Formatter::Console;
use TAP::Formatter::File;

use List::Util qw(max);

sub new
{
	my $class = shift;
	my $args = shift;

	my $self = $class->SUPER::new
								(
									{
										formatter => __getFormatter($args),
										jobs => $args->getJobs(),
										merge => $args->getMerge(),
										callbacks => { after_test => $args->getWorkDirManager()->getResultCollector() },
										'exec' => __getExecMapper($args),
										scheduler_class => 'App::TestOnTap::Scheduler'
									}
								);

	$self->{testontap} = { args => $args, pez => App::TestOnTap::Dispenser->new($args) };

	return $self;
}

sub make_scheduler
{
	my $self = shift;
	
	return $self->{scheduler_class}->new($self->{testontap}->{pez}, @_);
}

sub runtests
{
	my $self = shift;
	
	my $args = $self->{testontap}->{args}; 
	my $sr = $args->getSuiteRoot();
	
	my @pairs;
	push(@pairs, [ slashify("$sr/$_"), $_ ]) foreach ($self->{testontap}->{pez}->getAllTests());

	my $failed = 0;
	{
		my $wdmgr = $self->{testontap}->{args}->getWorkDirManager();

		local %ENV = %{$self->{testontap}->{args}->getPreprocess()->getEnv()};
		$ENV{TESTONTAP_SUITE_DIR} = $sr;
		$ENV{TESTONTAP_TMP_DIR} = $wdmgr->getTmp();
		$ENV{TESTONTAP_SAVE_DIR} = $wdmgr->getSaveSuite();
		
		if ($self->{testontap}->{args}->useHarness())
		{
			# the normal case is to run with a 'real' harness that parses
			# TAP, handles parallelization, formatters and all that
			#
			$wdmgr->beginTestRun();
			my $aggregator = $self->SUPER::runtests(@pairs); 
			$wdmgr->endTestRun($self->{testontap}->{args}, $aggregator);
			$failed = $aggregator->failed() || 0;
		}
		else
		{
			# if the user has requested 'no harness', just run the jobs serially
			# in the right context, but make no effort to parse their output
			# in any way - more convenient for debugging (esp. with an execmap
			# that can start a test in debug mode)
			#
			my $scheduler = $self->make_scheduler(@pairs);

			# figure out the longest test file name with some extra to produce some
			# nice delimiters...
			#
			my $longestTestFileName = 0;
			$longestTestFileName = max($longestTestFileName, length($_->[0])) foreach (@pairs);