File Coverage

blib/lib/TAPx/Parser/Result/Test.pm
Criterion Covered Total %
statement 42 42 100.0
branch 10 10 100.0
condition 5 5 100.0
subroutine 17 17 100.0
pod 12 12 100.0
total 86 86 100.0


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