File Coverage

blib/lib/Test/Compiles.pm

Criterion	Covered	Total	%
statement	89	92	96.7
branch	11	14	78.5
condition	6	11	54.5
subroutine	30	31	96.7
pod	2	2	100.0
total	138	150	92.0

use 5.008;
use strict;
use warnings;

package Test::Compiles;

our $AUTHORITY = 'cpan:TOBYINK';
our $VERSION   = '0.001';

use Exporter::Shiny our @EXPORT = qw( compiles doesnt_compile );

our $PRELUDE = '';

require Test::More;

sub compiles {
	@_ % 2 or splice(@_, 1, 0, 'message');
	my ($code, %opts) = @_;

	my $package = $opts{package} || caller;

	my $prepend = $PRELUDE || $opts{prelude} || '';
	$prepend .= ';use strict'
		if $opts{strict} || !exists $opts{strict};
	$prepend .= ';use warnings FATAL => qw(all)'
		if $opts{warnings};

	my $rand = 100_000 + int rand 900_000;
	my $e = do {
		local $@;
		local $SIG{__WARN__} = sub {};
		no strict; no warnings;
		eval "package $package;\n;"
			. "$prepend;\n;"
			. "$code;\n;"
			. "BEGIN { die \"ERROR$rand\" };\n;";
		$@;
	};
	my $result = (
		!$opts{should_fail} == !!($e =~ /\AERROR$rand\b/)
	);

	if (!$result) {
		Test::More::diag($opts{should_fail} ? "no error encountered": "error: $e");
	}

	$opts{message} ||= $opts{should_fail}
		? "code shouldn't compile"
		: "code should compile";

	@_ = ($result, $opts{message});
	goto \&Test::More::ok;
}

sub doesnt_compile {
	@_ % 2 or splice(@_, 1, 0, 'message');
	my ($code, %opts) = @_;
	$opts{should_fail} = !$opts{should_fail};
	@_ = ($code, %opts);
	goto \&compiles;
}

1;

__END__