File Coverage

blib/lib/Test/Flatten.pm
Criterion Covered Total %
statement 92 110 83.6
branch 21 36 58.3
condition 7 9 77.7
subroutine 17 18 94.4
pod 1 1 100.0
total 138 174 79.3


line stmt bran cond sub pod time code
1             package Test::Flatten;
2              
3 7     7   111337 use strict;
  7         14  
  7         223  
4 7     7   27 use warnings;
  7         7  
  7         152  
5 7     7   26 use Test::More ();
  7         12  
  7         86  
6 7     7   24 use Test::Builder ();
  7         8  
  7         125  
7 7     7   4362 use Term::ANSIColor qw(colored);
  7         43579  
  7         2923  
8              
9             our $VERSION = '0.10';
10              
11             our $BORDER_COLOR = [qw|cyan bold|];
12             our $BORDER_CHAR = '-';
13             our $BORDER_LENGTH = 78;
14             our $CAPTION_COLOR = ['clear'];
15             our $NOTE_COLOR = ['yellow'];
16              
17             our $ORG_SUBTEST = Test::More->can('subtest');
18              
19             $ENV{ANSI_COLORS_DISABLED} = 1 if $^O eq 'MSWin32';
20              
21             sub import {
22 7     7   44 my $class = caller(0);
23 7     7   44 no warnings qw(redefine prototype);
  7         8  
  7         264  
24 7     7   25 no strict 'refs';
  7         6  
  7         1986  
25 7         12 *{"$class\::subtest"} = \&subtest;
  7         29  
26 7         7549 *Test::More::subtest = \&subtest;
27             }
28              
29             my $TEST_DIFF = 0;
30             END {
31 7 50   7   629 if ($TEST_DIFF) {
32 0         0 my $builder = Test::More->builder;
33 0         0 _diag_plan($builder->{Curr_Test} - $TEST_DIFF, $builder->{Curr_Test});
34 0         0 Test::Builder::_my_exit(255); # report fail
35 0         0 undef $Test::Builder::Test; # disabled original END{} block
36             }
37             }
38              
39             sub subtest {
40 20     20 1 3258 my ($caption, $test, @args) = @_;
41              
42 20         92 my $builder = Test::More->builder;
43 20 50       187 unless (ref $test eq 'CODE') {
44 0         0 $builder->croak("subtest()'s second argument must be a code ref");
45             }
46              
47             # copying original setting
48 20         33 my $current_test = $builder->{Curr_Test};
49 20         29 my $skip_all = $builder->{Skip_All};
50 20         22 my $have_plan = $builder->{Have_Plan};
51 20         27 my $no_plan = $builder->{No_Plan};
52 20         26 my $in_filter = $builder->{__in_filter__};
53              
54             ## this idea from http://d.hatena.ne.jp/tokuhirom/20111017/1318831330
55 20 100       59 if (my $filter = $ENV{SUBTEST_FILTER}) {
56 7 100 100     86 if ($caption =~ qr{$filter} || $in_filter) {
57 4         7 $builder->{__in_filter__} = 1;
58             }
59             else {
60 3         15 $builder->note(colored $NOTE_COLOR, "SKIP: $caption by SUBTEST_FILTER");
61 3         566 return;
62             }
63             }
64              
65 17         78 $builder->note(colored $BORDER_COLOR, $BORDER_CHAR x $BORDER_LENGTH);
66 17         2631 $builder->note(colored $CAPTION_COLOR, $caption);
67 17         2300 $builder->note(colored $BORDER_COLOR, $BORDER_CHAR x $BORDER_LENGTH);
68              
69             # reset
70 17         2202 $builder->{Have_Plan} = 0;
71              
72 7     7   30 no warnings 'redefine';
  7         10  
  7         206  
73 7     7   30 no strict 'refs';
  7         7  
  7         461  
74 17         49 local *{ref($builder).'::plan'} = _fake_plan(\my $tests, \my $is_skip_all);
  17         69  
75 17     1   37 local *{ref($builder).'::done_testing'} = sub {}; # temporary disabled
  17         43  
  1         266  
76              
77 7     7   65 use warnings;
  7         8  
  7         161  
78 7     7   25 use strict;
  7         7  
  7         3295  
79              
80 17         24 local $Test::Builder::Level = $Test::Builder::Level = 1;
81 17         19 my $is_passing = eval { $test->(@args); 1 };
  17         43  
  15         6038  
82 16         29 my $e = $@;
83              
84 16 50 66     48 die $e if $e && !eval { $e->isa('Test::Builder::Exception') };
  1         12  
85              
86 16 100 66     94 if ($is_skip_all) {
    50          
    50          
87 1         2 $builder->{Skip_All} = $skip_all;
88             }
89             elsif ($tests && $builder->{Curr_Test} != $current_test + $tests) {
90 0         0 _diag_plan($tests, $builder->{Curr_Test} - $current_test);
91 0         0 $TEST_DIFF = $builder->{Curr_Test} - $current_test - $tests;
92 0         0 $is_passing = $builder->is_passing(0);
93             }
94             elsif ($builder->{Curr_Test} == $current_test) {
95 0         0 $builder->croak("No tests run for subtest $caption");
96             }
97              
98             # restore
99 16         31 $builder->{Have_Plan} = $have_plan;
100 16         19 $builder->{No_Plan} = $no_plan;
101 16         21 $builder->{__in_filter__} = $in_filter;
102              
103 16         232 return $is_passing;
104             }
105              
106             sub _diag_plan {
107 0     0   0 my ($plan, $ran) = @_;
108 0 0       0 my $s = $plan == 1 ? '' : 's';
109 0         0 Test::More->builder->diag(sprintf 'Looks like you planned %d test%s but ran %d.',
110             $plan, $s, $ran,
111             );
112             }
113              
114             sub _fake_plan {
115 17     17   22 my ($tests, $is_skip_all) = @_;
116              
117             return sub {
118 4     4   51 my ($self, $cmd, $arg) = @_;
119 4 50       8 return unless $cmd;
120 4         5 local $Test::Builder::Level = $Test::Builder::Level + 2;
121 4 50       9 $self->croak("You tried to plan twice") if $self->{Have_Plan};
122              
123 4 100       19 if ($cmd eq 'no_plan') {
    100          
    50          
124 1         1 local $Test::Builder::Level = $Test::Builder::Level + 1;
125 1         4 $self->no_plan($arg);
126             }
127             elsif ($cmd eq 'skip_all') {
128 1         1 local $Test::Builder::Level = $Test::Builder::Level + 1;
129 1         2 $self->{Skip_All} = 1;
130 1 50       2 $self->note(join q{ }, 'SKIP:', $arg) unless $self->no_header;
131 1         178 $$is_skip_all = 1; # set flag
132 1         11 die bless {}, 'Test::Builder::Exception';
133             }
134             elsif ($cmd eq 'tests') {
135 2 50       3 if($arg) {
    0          
136 2         2 local $Test::Builder::Level = $Test::Builder::Level + 1;
137 2 50       11 unless ($arg =~ /^\+?\d+$/) {
138 0         0 $self->croak("Number of tests must be a positive integer. You gave it '$arg'");
139             }
140 2         4 $$tests = $arg; # set tests
141             }
142             elsif( !defined $arg ) {
143 0         0 $self->croak("Got an undefined number of tests");
144             }
145             else {
146 0         0 $self->croak("You said to run 0 tests");
147             }
148             }
149             else {
150 0         0 my @args = grep { defined } ( $cmd, $arg );
  0         0  
151 0         0 $self->croak("plan() doesn't understand @args");
152             }
153 3         11 return 1;
154 17         103 };
155             }
156              
157             1;
158             __END__