File Coverage

blib/lib/Test/Declare.pm
Criterion Covered Total %
statement 58 58 100.0
branch 3 6 50.0
condition 1 2 50.0
subroutine 22 22 100.0
pod 4 5 80.0
total 88 93 94.6


line stmt bran cond sub pod time code
1             package Test::Declare;
2 6     6   4524 use strict;
  6         11  
  6         217  
3 6     6   30 use warnings;
  6         62  
  6         165  
4 6     6   33 use base 'Exporter';
  6         17  
  6         1317  
5              
6             our $VERSION = '0.06';
7              
8             my @test_more_exports;
9             my @test_more_method;
10             BEGIN {
11 6     6   71 @test_more_method = qw(
12             use_ok require_ok
13             eq_array eq_hash eq_set
14             can_ok
15             );
16 6         165 @test_more_exports = (qw(
17             skip todo todo_skip
18             pass fail
19             plan
20             diag
21             BAIL_OUT
22             $TODO
23             ),@test_more_method);
24             }
25              
26 6     6   4294 use Test::More import => \@test_more_exports;
  6         20  
  6         67  
27 6     6   10608 use Test::Exception;
  6         110  
  6         27  
28 6     6   8950 use Test::Warn;
  6         1019  
  6         773  
29 6     6   6180 use Test::Output;
  6         128  
  6         41  
30 6     6   17479 use Test::Deep;
  6         3311  
  6         1351  
31 6     6   63 use Scalar::Util qw/set_prototype/;
  6         12  
  6         811  
32              
33             my @test_wrapper_method = qw(
34             cmp_ok ok dies_ok throws_ok
35             is isnt is_deeply like unlike
36             isa_ok cmp_deeply re cmp_bag
37             prints_ok stderr_ok
38             warning_like warnings_like warning_is warnings_are
39             stdout_is stdout_isnt stdout_like stdout_unlike
40             stderr_is stderr_isnt stderr_like stderr_unlike
41             combined_is combined_isnt combined_like combined_unlike
42             output_is output_isnt output_like output_unlike
43             );
44              
45             my @test_method = (@test_wrapper_method, @test_more_method);
46              
47             our @EXPORT = (@test_more_exports, @test_wrapper_method, qw/
48             init cleanup run test describe blocks
49             /);
50              
51             my $test_block_name;
52             sub test ($$) { ## no critic
53 15     15 1 33 $test_block_name = shift;
54 15         40 shift->();
55             }
56              
57             {
58 6     6   31 no strict 'refs'; ## no critic
  6         13  
  6         764  
59             for my $sub (qw/init cleanup/) {
60             *{"Test::Declare::${sub}"} = sub (&) {
61 2     2   12 goto $_[0];
62             };
63             }
64             }
65              
66 22     22 1 210 sub run (&) { $_[0] } ## no critic
67              
68             sub describe ($$) { ## no critic
69 7     7 1 27 goto $_[1];
70             }
71              
72 6     6   5837 use PPI;
  6         960137  
  6         1288  
73             sub PPI::Document::find_test_blocks {
74 5     5 0 14 my $self = shift;
75             my $blocks = $self->find(
76             sub {
77 5002         7761 $_[1]->isa('PPI::Token::Word')
78             and
79 789     789   10454 grep { $_[1]->{content} eq $_ } @test_method
80             }
81 5   50     67 )||[];
82 5         151 return @$blocks
83             }
84             sub blocks {
85 5     5 1 59 my @caller = caller;
86 5         154 my $file = $caller[1];
87 5 50       67 my $doc = PPI::Document->new($file) or die $!;
88 5         74522 return scalar( $doc->find_test_blocks );
89             }
90              
91             ## Test::More wrapper
92             {
93 6     6   70 no strict 'refs'; ## no critic
  6         11  
  6         1400  
94             for my $sub (qw/is like isa_ok isnt unlike cmp_ok ok/) {
95             my $proto = prototype("Test::More::${sub}");
96             (my $args = $proto) =~ s/;.*//;
97             my $args_num = length $args;
98             *{"Test::Declare::${sub}"} = set_prototype(sub {
99 12 50   12   824 push @_, $test_block_name if @_ == $args_num;
100 12         20 goto \&{"Test::More::${sub}"};
  12         93  
101             }, $proto);
102             }
103             *{"Test::Declare::is_deeply"} = sub {
104 1 50   1   11 push @_, $test_block_name if @_ == 2;
105 1         3 goto \&{"Test::More::is_deeply"};
  1         9  
106             }
107             }
108              
109             1;
110              
111             __END__