File Coverage

blib/lib/Test2/Tools/Basic.pm
Criterion Covered Total %
statement 72 75 96.0
branch 13 18 72.2
condition 3 5 60.0
subroutine 17 17 100.0
pod 11 11 100.0
total 116 126 92.0


line stmt bran cond sub pod time code
1             package Test2::Tools::Basic;
2 173     173   490179 use strict;
  173         430  
  173         5161  
3 173     173   861 use warnings;
  173         374  
  173         7304  
4              
5             our $VERSION = '0.000155';
6              
7 173     173   1826 use Carp qw/croak/;
  173         413  
  173         8700  
8 173     173   2348 use Test2::API qw/context/;
  173         151089  
  173         14410  
9              
10             our @EXPORT = qw{
11             ok pass fail diag note todo skip
12             plan skip_all done_testing bail_out
13             };
14 173     173   1237 use base 'Exporter';
  173         451  
  173         94839  
15              
16             sub ok($;$@) {
17 1702     1702 1 3383994 my ($bool, $name, @diag) = @_;
18 1702         6109 my $ctx = context();
19 1702         371800 $ctx->ok($bool, $name, \@diag);
20 1702         198245 $ctx->release;
21 1700 100       50914 return $bool ? 1 : 0;
22             }
23              
24             sub pass {
25 10     10 1 1113 my ($name) = @_;
26 10         51 my $ctx = context();
27 10         1424 $ctx->ok(1, $name);
28 10         4177 $ctx->release;
29 10         381 return 1;
30             }
31              
32             sub fail {
33 2     2 1 28 my ($name, @diag) = @_;
34 2         7 my $ctx = context();
35 2         159 $ctx->ok(0, $name, \@diag);
36 2         1074 $ctx->release;
37 2         53 return 0;
38             }
39              
40             sub diag {
41 12     12 1 23293 my $ctx = context();
42 12         6933 $ctx->diag( join '', grep { defined $_ } @_ );
  14         98  
43 12         3191 $ctx->release;
44             }
45              
46             sub note {
47 662     662 1 6011 my $ctx = context();
48 662         170858 $ctx->note( join '', grep { defined $_ } @_ );
  664         4424  
49 662         44559 $ctx->release;
50             }
51              
52             sub todo {
53 52     52 1 1677 my $reason = shift;
54 52         104 my $code = shift;
55              
56 52 100       3558 require Test2::Todo unless $INC{'Test2/Todo.pm'};
57 52         346 my $todo = Test2::Todo->new(reason => $reason);
58              
59 52 100       1485 return $code->() if $code;
60              
61 48 50       313 croak "Cannot use todo() in a void context without a codeblock"
62             unless defined wantarray;
63              
64 48         211 return $todo;
65             }
66              
67             sub skip {
68 2     2 1 54 my ($why, $num) = @_;
69 2   50     9 $num ||= 1;
70 2         8 my $ctx = context();
71 2         173 $ctx->skip("skipped test", $why) for 1 .. $num;
72 2         1811 $ctx->release;
73 173     173   1420 no warnings 'exiting';
  173         457  
  173         55640  
74 2         59 last SKIP;
75             }
76              
77             sub plan {
78 9     9 1 3288 my $plan = shift;
79 9         32 my $ctx = context();
80              
81 9 100 66     983 if ($plan && $plan =~ m/[^0-9]/) {
82 2 100       9 if ($plan eq 'tests') {
    50          
83 1         6 $plan = shift;
84             }
85             elsif ($plan eq 'skip_all') {
86 1         4 skip_all(@_);
87 0         0 $ctx->release;
88 0         0 return;
89             }
90             }
91              
92 8         44 $ctx->plan($plan);
93 8         2555 $ctx->release;
94             }
95              
96             sub skip_all {
97 29     29 1 3355 my ($reason) = @_;
98 29         519 my $ctx = context();
99 29         10916 $ctx->plan(0, SKIP => $reason);
100 2 50       1632 $ctx->release if $ctx;
101             }
102              
103             sub done_testing {
104 141     141 1 2465 my $ctx = context();
105 141         20645 $ctx->hub->finalize($ctx->trace, 1);
106 115         56189 $ctx->release;
107             }
108              
109             sub bail_out {
110 3     3 1 936 my ($reason) = @_;
111 3         11 my $ctx = context();
112 3         266 $ctx->bail($reason);
113 0 0         $ctx->release if $ctx;
114             }
115              
116             1;
117              
118             __END__