File Coverage

blib/lib/Test/Benchmark.pm

Criterion	Covered	Total	%
statement	65	66	98.4
branch	14	16	87.5
condition	4	6	66.6
subroutine	11	11	100.0
pod	3	5	60.0
total	97	104	93.2

# Copyright 2003 Fergal Daly  distributed under the GNU
# Lesser General Public License, you do not have to accept this license but
# nothing else gives you the right to use this software

use strict;
use warnings;

package Test::Benchmark;

use Test::Builder;

use Benchmark qw( timethis timestr );

use vars qw(
	$VERSION @EXPORT @ISA @CARP_NOT $VERBOSE
);

$VERSION = "0.004";
$VERBOSE = 0;

my $Test = Test::Builder->new;

require Exporter;
@ISA = qw( Exporter );
@EXPORT = qw( is_faster is_n_times_faster is_fastest );

use Carp qw( croak );
@CARP_NOT = qw( Test::Benchmark Benchmark );

sub is_fastest
{
	my $which = shift;
	my $times = shift;
	my $marks = shift;
	my $name = shift;

	my @marks;
	while (my ($name, $sub) = each %$marks)
	{
		my $res = get_res($times, $sub);

		my($r, $pu, $ps, $cu, $cs, $n) = @$res;

		push(@marks,
			{
				name => $name,
				res => $res,
				n => $n,
				s => ($pu+$ps),
			}
		);
	}

	@marks = sort {$b->{n} * $a->{s} <=> $a->{n} * $b->{s}} @marks;

	my $ok = $marks[0]->{name} eq $which;

	$Test->ok($ok, $name);

	if (not $ok)
	{
		$Test->diag("$which was not the fastest");
	}

	if (not $ok or $VERBOSE)
	{
		foreach my $mark (@marks)
		{
			$Test->diag("$mark->{name} - ".timestr($mark->{res}));
		}
	}
}

sub is_faster
{
	local $Test::Builder::Level = $Test::Builder::Level + 1;
	if (ref $_[1])
	{
		is_n_times_faster(1, @_);
	}
	else
	{
		is_n_times_faster(@_);
	}
}

sub is_n_times_faster
{
	my $factor = shift;
	my $times = shift;
	my $code1 = shift;
	my $code2 = shift;
	my $name = shift;

	my @res;

	my ($res1, $res2) = map {get_res($times, $_)} ($code1, $code2);

	my($r1, $pu1, $ps1, $cu1, $cs1, $n1) = @$res1;
	my($r2, $pu2, $ps2, $cu2, $cs2, $n2) = @$res2;

	# we want code1 to be faster than code2. Essentially we are comparing 2
	# fractions factor * n1/cpu1 > n2/cpu2 but in order to avoid div by zero
	# we use multiplication

	my $ok = ($n1 * ($pu2 + $ps2) * $factor) > ($n2 * ($pu1 + $ps1));
	$Test->ok($ok, $name);

	if (not $ok)
	{
		my $extra = ($factor == 1) ? "" : " at least $factor times";
		$Test->diag("code1 was not$extra faster than code 2");
	}

	if (not $ok or $VERBOSE)
	{
		$Test->diag(timestr($res1));
		$Test->diag(timestr($res2));
	}
	return $ok;
}

sub get_res
{
	my ($times, $sub) = @_;

	if (ref($sub) eq "Benchmark")
	{
		return $sub;
	}
	elsif (0)
	{
		# get from cache not implemented - maybe never will be...
	}
	else
	{
		return timethis($times, $sub, "", "none");
	}
}

sub builder
{
	if (@_)
	{
		$Test = shift;
	}
	return $Test;
}

1;

__END__