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


line stmt bran cond sub pod time code
1             package Test::Stream::DeferredTests;
2 12     12   3707 use strict;
  12         25  
  12         282  
3 12     12   59 use warnings;
  12         24  
  12         310  
4              
5 12     12   53 use Carp qw/croak/;
  12         24  
  12         584  
6 12     12   640 use Test::Stream::Util qw/get_tid/;
  12         24  
  12         74  
7              
8 12     12   68 use Test::Stream::Exporter;
  12         17  
  12         86  
9             default_exports qw/def do_def/;
10 12     12   69 no Test::Stream::Exporter;
  12         17  
  12         56  
11              
12             my %TODO;
13              
14             sub def {
15 374     374 1 1416 my ($func, @args) = @_;
16              
17 374         2568 my @caller = caller(0);
18              
19 374   100     1289 $TODO{$caller[0]} ||= [];
20 374         427 push @{$TODO{$caller[0]}} => [$func, \@args, \@caller];
  374         12113  
21             }
22              
23             sub do_def {
24 14     14 1 159 my $for = caller;
25 14 100       229 my $tests = delete $TODO{$for} or croak "No tests to run!";
26              
27 13         49 for my $test (@$tests) {
28 257         4932 my ($func, $args, $caller) = @$test;
29              
30 257         642 my ($pkg, $file, $line) = @$caller;
31              
32             # Note: The '&' below is to bypass the prototype, which is important here.
33 257 100       9493 eval <<" EOT" or die $@;
34             package $pkg;
35             # line $line "$file"
36             \&$func(\@\$args);
37             1;
38             EOT
39             }
40             }
41              
42             sub _verify {
43 14 100   14   301 return if Test::Stream::Sync->pid != $$;
44 10 50       54 return if Test::Stream::Sync->tid != get_tid();
45 10         22 my $not_ok = 0;
46 10         67 for my $pkg (keys %TODO) {
47 3         13 delete $TODO{$pkg};
48 3 100       12 print STDOUT "not ok - deferred tests were not run!\n" unless $not_ok++;
49 3         9 print STDERR "# '$pkg' has deferred tests that were never run!\n";
50 3   100     21 $? ||= 255;
51             }
52             }
53              
54 12     12   1081 END { _verify() }
55              
56             1;
57              
58             __END__