File Coverage

blib/lib/Test2/Tools/Defer.pm
Criterion Covered Total %
statement 45 45 100.0
branch 6 6 100.0
condition 4 4 100.0
subroutine 9 9 100.0
pod 2 2 100.0
total 66 66 100.0


line stmt bran cond sub pod time code
1             package Test2::Tools::Defer;
2 156     156   76611 use strict;
  156         366  
  156         4387  
3 156     156   813 use warnings;
  156         312  
  156         5994  
4              
5             our $VERSION = '0.000155';
6              
7 156     156   958 use Carp qw/croak/;
  156         309  
  156         7423  
8              
9 156     156   2002 use Test2::Util qw/get_tid/;
  156         24200  
  156         7864  
10 156         11789 use Test2::API qw{
11             test2_add_callback_exit
12             test2_pid test2_tid
13 156     156   2270 };
  156         123180  
14              
15             our @EXPORT = qw/def do_def/;
16 156     156   1174 use base 'Exporter';
  156         419  
  156         93936  
17              
18             my %TODO;
19              
20             sub def {
21 54     54 1 739 my ($func, @args) = @_;
22              
23 54         390 my @caller = caller(0);
24              
25 54   100     227 $TODO{$caller[0]} ||= [];
26 54         88 push @{$TODO{$caller[0]}} => [$func, \@args, \@caller];
  54         343  
27             }
28              
29             sub do_def {
30 11     11 1 33479 my $for = caller;
31 11 100       259 my $tests = delete $TODO{$for} or croak "No tests to run!";
32              
33 10         41 for my $test (@$tests) {
34 51         929 my ($func, $args, $caller) = @$test;
35              
36 51         140 my ($pkg, $file, $line) = @$caller;
37              
38 51         209 chomp(my $eval = <<" EOT");
39             package $pkg;
40             # line $line "(eval in Test2::Tools::Defer) $file"
41             \&$func(\@\$args);
42             1;
43             EOT
44              
45 51 100       4677 eval $eval and next;
46 1         25 chomp(my $error = $@);
47              
48 1         674 require Data::Dumper;
49 1         6543 chomp(my $td = Data::Dumper::Dumper($args));
50 1         71 $td =~ s/^\$VAR1 =/\$args: /;
51 1         23 die <<" EOT";
52             Exception: $error
53             --eval--
54             $eval
55             --------
56             Tool: $func
57             Caller: $caller->[0], $caller->[1], $caller->[2]
58             $td
59             EOT
60             }
61              
62 9         304 return;
63             }
64              
65             sub _verify {
66 105     105   6082 my ($context, $exit, $new_exit) = @_;
67              
68 105         457 my $not_ok = 0;
69 105         1141 for my $pkg (keys %TODO) {
70 3         10 my $tests = delete $TODO{$pkg};
71 3         6 my $caller = $tests->[0]->[-1];
72 3 100       13 print STDOUT "not ok - deferred tests were not run!\n" unless $not_ok++;
73 3         10 print STDERR "# '$pkg' has deferred tests that were never run!\n";
74 3         11 print STDERR "# $caller->[1] at line $caller->[2]\n";
75 3   100     19 $$new_exit ||= 255;
76             }
77             }
78              
79             test2_add_callback_exit(\&_verify);
80              
81             1;
82              
83             __END__