1package TAP::Parser::Result::Test;
2
3use strict;
4use warnings;
5
6use base 'TAP::Parser::Result';
7
8=head1 NAME
9
10TAP::Parser::Result::Test - Test result token.
11
12=head1 VERSION
13
14Version 3.42
15
16=cut
17
18our $VERSION = '3.42';
19
20=head1 DESCRIPTION
21
22This is a subclass of L<TAP::Parser::Result>.  A token of this class will be
23returned if a test line is encountered.
24
25 1..1
26 ok 1 - woo hooo!
27
28=head1 OVERRIDDEN METHODS
29
30This class is the workhorse of the L<TAP::Parser> system.  Most TAP lines will
31be test lines and if C<< $result->is_test >>, then you have a bunch of methods
32at your disposal.
33
34=head2 Instance Methods
35
36=cut
37
38##############################################################################
39
40=head3 C<ok>
41
42  my $ok = $result->ok;
43
44Returns the literal text of the C<ok> or C<not ok> status.
45
46=cut
47
48sub ok { shift->{ok} }
49
50##############################################################################
51
52=head3 C<number>
53
54  my $test_number = $result->number;
55
56Returns the number of the test, even if the original TAP output did not supply
57that number.
58
59=cut
60
61sub number { shift->{test_num} }
62
63sub _number {
64    my ( $self, $number ) = @_;
65    $self->{test_num} = $number;
66}
67
68##############################################################################
69
70=head3 C<description>
71
72  my $description = $result->description;
73
74Returns the description of the test, if any.  This is the portion after the
75test number but before the directive.
76
77=cut
78
79sub description { shift->{description} }
80
81##############################################################################
82
83=head3 C<directive>
84
85  my $directive = $result->directive;
86
87Returns either C<TODO> or C<SKIP> if either directive was present for a test
88line.
89
90=cut
91
92sub directive { shift->{directive} }
93
94##############################################################################
95
96=head3 C<explanation>
97
98  my $explanation = $result->explanation;
99
100If a test had either a C<TODO> or C<SKIP> directive, this method will return
101the accompanying explanation, if present.
102
103  not ok 17 - 'Pigs can fly' # TODO not enough acid
104
105For the above line, the explanation is I<not enough acid>.
106
107=cut
108
109sub explanation { shift->{explanation} }
110
111##############################################################################
112
113=head3 C<is_ok>
114
115  if ( $result->is_ok ) { ... }
116
117Returns a boolean value indicating whether or not the test passed.  Remember
118that for TODO tests, the test always passes.
119
120If the test is unplanned, this method will always return false.  See
121C<is_unplanned>.
122
123=cut
124
125sub is_ok {
126    my $self = shift;
127
128    return if $self->is_unplanned;
129
130    # TODO directives reverse the sense of a test.
131    return $self->has_todo ? 1 : $self->ok !~ /not/;
132}
133
134##############################################################################
135
136=head3 C<is_actual_ok>
137
138  if ( $result->is_actual_ok ) { ... }
139
140Returns a boolean value indicating whether or not the test passed, regardless
141of its TODO status.
142
143=cut
144
145sub is_actual_ok {
146    my $self = shift;
147    return $self->{ok} !~ /not/;
148}
149
150##############################################################################
151
152=head3 C<actual_passed>
153
154Deprecated.  Please use C<is_actual_ok> instead.
155
156=cut
157
158sub actual_passed {
159    warn 'actual_passed() is deprecated.  Please use "is_actual_ok()"';
160    goto &is_actual_ok;
161}
162
163##############################################################################
164
165=head3 C<todo_passed>
166
167  if ( $test->todo_passed ) {
168     # test unexpectedly succeeded
169  }
170
171If this is a TODO test and an 'ok' line, this method returns true.
172Otherwise, it will always return false (regardless of passing status on
173non-todo tests).
174
175This is used to track which tests unexpectedly succeeded.
176
177=cut
178
179sub todo_passed {
180    my $self = shift;
181    return $self->has_todo && $self->is_actual_ok;
182}
183
184##############################################################################
185
186=head3 C<todo_failed>
187
188  # deprecated in favor of 'todo_passed'.  This method was horribly misnamed.
189
190This was a badly misnamed method.  It indicates which TODO tests unexpectedly
191succeeded.  Will now issue a warning and call C<todo_passed>.
192
193=cut
194
195sub todo_failed {
196    warn 'todo_failed() is deprecated.  Please use "todo_passed()"';
197    goto &todo_passed;
198}
199
200##############################################################################
201
202=head3 C<has_skip>
203
204  if ( $result->has_skip ) { ... }
205
206Returns a boolean value indicating whether or not this test has a SKIP
207directive.
208
209=head3 C<has_todo>
210
211  if ( $result->has_todo ) { ... }
212
213Returns a boolean value indicating whether or not this test has a TODO
214directive.
215
216=head3 C<as_string>
217
218  print $result->as_string;
219
220This method prints the test as a string.  It will probably be similar, but
221not necessarily identical, to the original test line.  Directives are
222capitalized, some whitespace may be trimmed and a test number will be added if
223it was not present in the original line.  If you need the original text of the
224test line, use the C<raw> method.
225
226=cut
227
228sub as_string {
229    my $self   = shift;
230    my $string = $self->ok . " " . $self->number;
231    if ( my $description = $self->description ) {
232        $string .= " $description";
233    }
234    if ( my $directive = $self->directive ) {
235        my $explanation = $self->explanation;
236        $string .= " # $directive $explanation";
237    }
238    return $string;
239}
240
241##############################################################################
242
243=head3 C<is_unplanned>
244
245  if ( $test->is_unplanned ) { ... }
246  $test->is_unplanned(1);
247
248If a test number is greater than the number of planned tests, this method will
249return true.  Unplanned tests will I<always> return false for C<is_ok>,
250regardless of whether or not the test C<has_todo>.
251
252Note that if tests have a trailing plan, it is not possible to set this
253property for unplanned tests as we do not know it's unplanned until the plan
254is reached:
255
256  print <<'END';
257  ok 1
258  ok 2
259  1..1
260  END
261
262=cut
263
264sub is_unplanned {
265    my $self = shift;
266    return ( $self->{unplanned} || '' ) unless @_;
267    $self->{unplanned} = !!shift;
268    return $self;
269}
270
2711;
272