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