File Coverage

blib/lib/Test/Stream/DeferredTests.pm

Criterion	Covered	Total	%
statement	38	38	100.0
branch	9	10	90.0
condition	4	4	100.0
subroutine	10	10	100.0
pod	2	2	100.0
total	63	64	98.4

package Test::Stream::DeferredTests;
use strict;
use warnings;

use Carp qw/croak/;
use Test::Stream::Util qw/get_tid/;

use Test::Stream::Exporter;
default_exports qw/def do_def/;
no Test::Stream::Exporter;

my %TODO;

sub def {
    my ($func, @args) = @_;

    my @caller = caller(0);

    $TODO{$caller[0]} ||= [];
    push @{$TODO{$caller[0]}} => [$func, \@args, \@caller];
}

sub do_def {
    my $for = caller;
    my $tests = delete $TODO{$for} or croak "No tests to run!";

    for my $test (@$tests) {
        my ($func, $args, $caller) = @$test;

        my ($pkg, $file, $line) = @$caller;

# Note: The '&' below is to bypass the prototype, which is important here.
        eval <<"        EOT" or die $@;
package $pkg;
# line $line "$file"
\&$func(\@\$args);
1;
        EOT
    }
}

sub _verify {
    return if Test::Stream::Sync->pid != $$;
    return if Test::Stream::Sync->tid != get_tid();
    my $not_ok = 0;
    for my $pkg (keys %TODO) {
        delete $TODO{$pkg};
        print STDOUT "not ok - deferred tests were not run!\n" unless $not_ok++;
        print STDERR "# '$pkg' has deferred tests that were never run!\n";
        $? ||= 255;
    }
}

END { _verify() }

1;

__END__