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