File Coverage

lib/Test/Easy.pm

Criterion	Covered	Total	%
statement	16	18	88.8
branch			n/a
condition			n/a
subroutine	6	6	100.0
pod			n/a
total	22	24	91.6

use strict;
use warnings;
package Test::Easy;
use base qw(Exporter);

use 5.006002;

# used as helper modules within this module
require Test::More;
use Carp qw(confess);

# this module re-exports functions from these modules
use Test::Easy::DataDriven;
use Test::Easy::DeepEqual;
use Test::Easy::Time;
use Test::Resub;

our $VERSION = 1.09;

## spend a little time moving things around into @EXPORT, @EXPORT_OK
our @EXPORT = qw(nearly_ok around_about wiretap);
our @EXPORT_OK = qw(nearly test_sub);
foreach my $supplier (qw(
	Test::Resub
	Test::Easy::DataDriven
	Test::Easy::Time
	Test::Easy::DeepEqual
)) {
	no strict 'refs';
	push @EXPORT, @{"$supplier\::EXPORT"};
	push @EXPORT_OK, @{"$supplier\::EXPORT_TAGS"};
}

# Set up %EXPORT_TAGS based on whatever we've shoved into @EXPORT, @EXPORT_OK
our %EXPORT_TAGS = (
	helpers => [@EXPORT_OK],
	all => [@EXPORT, @EXPORT_OK],
);
foreach my $supplier (qw(Test::Resub Test::Easy::DataDriven)) {
	no strict 'refs';
	%EXPORT_TAGS = _merge(%EXPORT_TAGS, %{"$supplier\::EXPORT_TAGS"});
}

sub _merge {
	my %out;
	while (my ($k, $v) = splice @_, 0, 2) {
		push @{$out{$k}}, @$v;
	}
	return %out;
}

# code begins here

sub nearly_ok {
  my ($got, $expected, $epsilon, $message) = @_;
  local $Test::Builder::Level = $Test::Builder::Level + 1;
  Test::More::ok( nearly($got, $expected, $epsilon), $message )
		 or warn "expected $got to be $expected +/- $epsilon; actual difference was " . ($expected - $got) . "\n";
}

sub nearly {
	my ($got, $expected, $epsilon) = @_;
  my $close = abs($expected - $got) <= $epsilon;
	return !!$close;
}

sub around_about {
	my ($now, $epsilon) = @_;

	$epsilon ||= 0;

	return Test::Easy::equivalence->new(
		raw  => [$now, $epsilon],
		explain => sub {
			my ($got, $raw) = @_;
			return sprintf '%s within %s seconds of %s', $got, reverse @$raw;
		},
		test => sub {
			my ($got) = @_;
			return time_nearly($got, $now, $epsilon);
		},
	);
}

sub test_sub (&) {
  my $test = shift;
  return sub {
    local $Test::Builder::Level = $Test::Builder::Level + 1;
    goto &$test;
  };
}

sub wiretap {
	my ($target, $pre, @args) = @_;
	my $rs;
	$rs = resub $target, sub {
		$pre->(@_) if $pre;
		$rs->{orig_code}->(@_);
	}, @args;
}

1;

__END__