This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Upgrade Test::Simple from version 1.302052 to 1.302056
[perl5.git] / cpan / Test-Simple / lib / Test2 / Event / Plan.pm
CommitLineData
b4514920
CG
1package Test2::Event::Plan;
2use strict;
3use warnings;
4
7aa7bbc7 5our $VERSION = '1.302056';
b4514920
CG
6
7
58818a66 8BEGIN { require Test2::Event; our @ISA = qw(Test2::Event) }
b4514920
CG
9use Test2::Util::HashBase qw{max directive reason};
10
11use Carp qw/confess/;
12
13my %ALLOWED = (
14 'SKIP' => 1,
15 'NO PLAN' => 1,
16);
17
18sub 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
40sub sets_plan {
41 my $self = shift;
42 return (
43 $self->{+MAX},
44 $self->{+DIRECTIVE},
45 $self->{+REASON},
46 );
47}
48
49sub 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
60sub 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
67sub 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
821;
83
84__END__
85
86=pod
87
88=encoding UTF-8
89
90=head1 NAME
91
92Test2::Event::Plan - The event of a plan
93
94=head1 DESCRIPTION
95
96Plan events are fired off whenever a plan is declared, done testing is called,
97or 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
118Get the number of expected tests
119
120=item $dir = $plan->directive
121
122Get the directive (such as TODO, skip_all, or no_plan).
123
124=item $reason = $plan->reason
125
126Get the reason for the directive.
127
128=back
129
130=head1 SOURCE
131
132The source code repository for Test2 can be found at
133F<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
153Copyright 2016 Chad Granum E<lt>exodist@cpan.orgE<gt>.
154
155This program is free software; you can redistribute it and/or
156modify it under the same terms as Perl itself.
157
158See F<http://dev.perl.org/licenses/>
159
160=cut