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   516679 use strict;
  173         467  
  173         5451  
3 173     173   994 use warnings;
  173         340  
  173         7779  
4              
5             our $VERSION = '0.000156';
6              
7 173     173   997 use Carp qw/croak/;
  173         370  
  173         8957  
8 173     173   2483 use Test2::API qw/context/;
  173         155616  
  173         14603  
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   1322 use base 'Exporter';
  173         410  
  173         98309  
15              
16             sub ok($;$@) {
17 1731     1731 1 3449949 my ($bool, $name, @diag) = @_;
18 1731         5323 my $ctx = context();
19 1731         338289 $ctx->ok($bool, $name, \@diag);
20 1731         189556 $ctx->release;
21 1729 100       61909 return $bool ? 1 : 0;
22             }
23              
24             sub pass {
25 10     10 1 1103 my ($name) = @_;
26 10         44 my $ctx = context();
27 10         1500 $ctx->ok(1, $name);
28 10         4412 $ctx->release;
29 10         418 return 1;
30             }
31              
32             sub fail {
33 2     2 1 44 my ($name, @diag) = @_;
34 2         8 my $ctx = context();
35 2         178 $ctx->ok(0, $name, \@diag);
36 2         1075 $ctx->release;
37 2         55 return 0;
38             }
39              
40             sub diag {
41 12     12 1 23807 my $ctx = context();
42 12         7353 $ctx->diag( join '', grep { defined $_ } @_ );
  14         93  
43 12         3189 $ctx->release;
44             }
45              
46             sub note {
47 662     662 1 6405 my $ctx = context();
48 662         176612 $ctx->note( join '', grep { defined $_ } @_ );
  664         4597  
49 662         45776 $ctx->release;
50             }
51              
52             sub todo {
53 54     54 1 1428 my $reason = shift;
54 54         85 my $code = shift;
55              
56 54 100       3801 require Test2::Todo unless $INC{'Test2/Todo.pm'};
57 54         343 my $todo = Test2::Todo->new(reason => $reason);
58              
59 54 100       1237 return $code->() if $code;
60              
61 50 50       265 croak "Cannot use todo() in a void context without a codeblock"
62             unless defined wantarray;
63              
64 50         148 return $todo;
65             }
66              
67             sub skip {
68 2     2 1 57 my ($why, $num) = @_;
69 2   50     9 $num ||= 1;
70 2         10 my $ctx = context();
71 2         181 $ctx->skip("skipped test", $why) for 1 .. $num;
72 2         1795 $ctx->release;
73 173     173   1507 no warnings 'exiting';
  173         468  
  173         58522  
74 2         65 last SKIP;
75             }
76              
77             sub plan {
78 9     9 1 3397 my $plan = shift;
79 9         37 my $ctx = context();
80              
81 9 100 66     1054 if ($plan && $plan =~ m/[^0-9]/) {
82 2 100       13 if ($plan eq 'tests') {
    50          
83 1         3 $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         51 $ctx->plan($plan);
93 8         2631 $ctx->release;
94             }
95              
96             sub skip_all {
97 29     29 1 3142 my ($reason) = @_;
98 29         484 my $ctx = context();
99 29         9446 $ctx->plan(0, SKIP => $reason);
100 2 50       1355 $ctx->release if $ctx;
101             }
102              
103             sub done_testing {
104 141     141 1 2271 my $ctx = context();
105 141         21774 $ctx->hub->finalize($ctx->trace, 1);
106 115         55861 $ctx->release;
107             }
108              
109             sub bail_out {
110 3     3 1 911 my ($reason) = @_;
111 3         9 my $ctx = context();
112 3         275 $ctx->bail($reason);
113 0 0         $ctx->release if $ctx;
114             }
115              
116             1;
117              
118             __END__