File Coverage

blib/lib/TAP/Parser/Result/Test.pm
Criterion Covered Total %
statement 39 39 100.0
branch 10 10 100.0
condition 5 5 100.0
subroutine 16 16 100.0
pod 12 12 100.0
total 82 82 100.0


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