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   112 use strict;
  32         31  
  32         863  
4 32     32   488 use warnings;
  32         32  
  32         724  
5              
6 32     32   111 use base 'TAP::Parser::Result';
  32         36  
  32         16692  
7              
8             =head1 NAME
9              
10             TAP::Parser::Result::Test - Test result token.
11              
12             =head1 VERSION
13              
14             Version 3.39
15              
16             =cut
17              
18             our $VERSION = '3.39';
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 1410     1410 1 7503 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 1243     1243 1 103287 sub number { shift->{test_num} }
62              
63             sub _number {
64 46     46   63 my ( $self, $number ) = @_;
65 46         87 $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 750     750 1 99936 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 1520 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 52192 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 1567     1567 1 110693 my $self = shift;
127              
128 1567 100       2614 return if $self->is_unplanned;
129              
130             # TODO directives reverse the sense of a test.
131 1453 100       3252 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 1614     1614 1 124230 my $self = shift;
147 1614         6319 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 341     341 1 101018 warn 'actual_passed() is deprecated. Please use "is_actual_ok()"';
160 341         97045 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 867     867 1 2448 my $self = shift;
181 867   100     1558 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 11 warn 'todo_failed() is deprecated. Please use "todo_passed()"';
197 1         7 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 1509 my $self = shift;
230 31         47 my $string = $self->ok . " " . $self->number;
231 31 100       49 if ( my $description = $self->description ) {
232 26         45 $string .= " $description";
233             }
234 31 100       44 if ( my $directive = $self->directive ) {
235 13         20 my $explanation = $self->explanation;
236 13         29 $string .= " # $directive $explanation";
237             }
238 31         101 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 1695     1695 1 26532 my $self = shift;
266 1695 100 100     10226 return ( $self->{unplanned} || '' ) unless @_;
267 50         152 $self->{unplanned} = !!shift;
268 50         104 return $self;
269             }
270              
271             1;