File Coverage

blib/lib/Test2/Event/Plan.pm
Criterion Covered Total %
statement 43 43 100.0
branch 31 32 96.8
condition 5 6 83.3
subroutine 10 10 100.0
pod 4 5 80.0
total 93 96 96.8


line stmt bran cond sub pod time code
1             package Test2::Event::Plan;
2 246     246   2077 use strict;
  246         505  
  246         7202  
3 246     246   1211 use warnings;
  246         482  
  246         13359  
4              
5             our $VERSION = '1.302181';
6              
7              
8 246     246   1425 BEGIN { require Test2::Event; our @ISA = qw(Test2::Event) }
  246         10522  
9 246     246   1880 use Test2::Util::HashBase qw{max directive reason};
  246         627  
  246         1728  
10              
11 246     246   1663 use Carp qw/confess/;
  246         607  
  246         157054  
12              
13             my %ALLOWED = (
14             'SKIP' => 1,
15             'NO PLAN' => 1,
16             );
17              
18             sub init {
19 554 100   554 0 2861 if ($_[0]->{+DIRECTIVE}) {
20 30 100       176 $_[0]->{+DIRECTIVE} = 'SKIP' if $_[0]->{+DIRECTIVE} eq 'skip_all';
21 30 100       129 $_[0]->{+DIRECTIVE} = 'NO PLAN' if $_[0]->{+DIRECTIVE} eq 'no_plan';
22              
23             confess "'" . $_[0]->{+DIRECTIVE} . "' is not a valid plan directive"
24 30 100       358 unless $ALLOWED{$_[0]->{+DIRECTIVE}};
25             }
26             else {
27             confess "Cannot have a reason without a directive!"
28 524 100       1956 if defined $_[0]->{+REASON};
29              
30             confess "No number of tests specified"
31 523 100       1815 unless defined $_[0]->{+MAX};
32              
33             confess "Plan test count '" . $_[0]->{+MAX} . "' does not appear to be a valid positive integer"
34 522 100       4026 unless $_[0]->{+MAX} =~ m/^\d+$/;
35              
36 521         1866 $_[0]->{+DIRECTIVE} = '';
37             }
38             }
39              
40             sub sets_plan {
41 3     3 1 7 my $self = shift;
42             return (
43             $self->{+MAX},
44             $self->{+DIRECTIVE},
45 3         24 $self->{+REASON},
46             );
47             }
48              
49             sub terminate {
50 193     193 1 462 my $self = shift;
51             # On skip_all we want to terminate the hub
52 193 100 100     815 return 0 if $self->{+DIRECTIVE} && $self->{+DIRECTIVE} eq 'SKIP';
53 192         1500 return undef;
54             }
55              
56             sub summary {
57 3     3 1 10 my $self = shift;
58 3         6 my $max = $self->{+MAX};
59 3         6 my $directive = $self->{+DIRECTIVE};
60 3         5 my $reason = $self->{+REASON};
61              
62 3 100 66     20 return "Plan is $max assertions"
63             if $max || !$directive;
64              
65 2 100       9 return "Plan is '$directive', $reason"
66             if $reason;
67              
68 1         6 return "Plan is '$directive'";
69             }
70              
71             sub facet_data {
72 1273     1273 1 2385 my $self = shift;
73              
74 1273         4560 my $out = $self->common_facet_data;
75              
76             $out->{control}->{terminate} = $self->{+DIRECTIVE} eq 'SKIP' ? 0 : undef
77 1273 100       6586 unless defined $out->{control}->{terminate};
    50          
78              
79 1273         3770 $out->{plan} = {count => $self->{+MAX}};
80 1273 100       3461 $out->{plan}->{details} = $self->{+REASON} if defined $self->{+REASON};
81              
82 1273 100       3407 if (my $dir = $self->{+DIRECTIVE}) {
83 51 100       185 $out->{plan}->{skip} = 1 if $dir eq 'SKIP';
84 51 100       157 $out->{plan}->{none} = 1 if $dir eq 'NO PLAN';
85             }
86              
87 1273         4044 return $out;
88             }
89              
90              
91             1;
92              
93             __END__
94              
95             =pod
96              
97             =encoding UTF-8
98              
99             =head1 NAME
100              
101             Test2::Event::Plan - The event of a plan
102              
103             =head1 DESCRIPTION
104              
105             Plan events are fired off whenever a plan is declared, done testing is called,
106             or a subtext completes.
107              
108             =head1 SYNOPSIS
109              
110             use Test2::API qw/context/;
111             use Test2::Event::Plan;
112              
113             my $ctx = context();
114              
115             # Plan for 10 tests to run
116             my $event = $ctx->plan(10);
117              
118             # Plan to skip all tests (will exit 0)
119             $ctx->plan(0, skip_all => "These tests need to be skipped");
120              
121             =head1 ACCESSORS
122              
123             =over 4
124              
125             =item $num = $plan->max
126              
127             Get the number of expected tests
128              
129             =item $dir = $plan->directive
130              
131             Get the directive (such as TODO, skip_all, or no_plan).
132              
133             =item $reason = $plan->reason
134              
135             Get the reason for the directive.
136              
137             =back
138              
139             =head1 SOURCE
140              
141             The source code repository for Test2 can be found at
142             F<http://github.com/Test-More/test-more/>.
143              
144             =head1 MAINTAINERS
145              
146             =over 4
147              
148             =item Chad Granum E<lt>exodist@cpan.orgE<gt>
149              
150             =back
151              
152             =head1 AUTHORS
153              
154             =over 4
155              
156             =item Chad Granum E<lt>exodist@cpan.orgE<gt>
157              
158             =back
159              
160             =head1 COPYRIGHT
161              
162             Copyright 2020 Chad Granum E<lt>exodist@cpan.orgE<gt>.
163              
164             This program is free software; you can redistribute it and/or
165             modify it under the same terms as Perl itself.
166              
167             See F<http://dev.perl.org/licenses/>
168              
169             =cut