Commit | Line | Data |
b965d173 |
1 | package TAP::Parser::Result; |
2 | |
3 | use strict; |
4 | use vars qw($VERSION); |
5 | |
6 | use TAP::Parser::Result::Bailout (); |
7 | use TAP::Parser::Result::Comment (); |
8 | use TAP::Parser::Result::Plan (); |
9 | use TAP::Parser::Result::Test (); |
10 | use TAP::Parser::Result::Unknown (); |
11 | use TAP::Parser::Result::Version (); |
12 | use TAP::Parser::Result::YAML (); |
13 | |
14 | BEGIN { |
15 | no strict 'refs'; |
16 | foreach my $token (qw( plan comment test bailout version unknown yaml )) { |
17 | my $method = "is_$token"; |
18 | *$method = sub { return $token eq shift->type }; |
19 | } |
20 | } |
21 | |
22 | ############################################################################## |
23 | |
24 | =head1 NAME |
25 | |
26 | TAP::Parser::Result - TAP::Parser output |
27 | |
28 | =head1 VERSION |
29 | |
69f36734 |
30 | Version 3.06 |
b965d173 |
31 | |
32 | =cut |
33 | |
69f36734 |
34 | $VERSION = '3.06'; |
b965d173 |
35 | |
36 | =head2 DESCRIPTION |
37 | |
38 | This is merely a factory class which returns an object representing the |
39 | current bit of test data from TAP (usually a line). It's for internal use |
40 | only and should not be relied upon. |
41 | |
42 | =cut |
43 | |
44 | # note that this is bad. Makes it very difficult to subclass, but then, it |
45 | # would be a lot of work to subclass this system. |
46 | my %class_for = ( |
47 | plan => 'TAP::Parser::Result::Plan', |
48 | test => 'TAP::Parser::Result::Test', |
49 | comment => 'TAP::Parser::Result::Comment', |
50 | bailout => 'TAP::Parser::Result::Bailout', |
51 | version => 'TAP::Parser::Result::Version', |
52 | unknown => 'TAP::Parser::Result::Unknown', |
53 | yaml => 'TAP::Parser::Result::YAML', |
54 | ); |
55 | |
56 | ############################################################################## |
57 | |
58 | =head2 METHODS |
59 | |
60 | =head3 C<new> |
61 | |
62 | my $result = TAP::Parser::Result->new($token); |
63 | |
64 | Returns an instance the appropriate class for the test token passed in. |
65 | |
66 | =cut |
67 | |
68 | sub new { |
69 | my ( $class, $token ) = @_; |
70 | my $type = $token->{type}; |
71 | return bless $token => $class_for{$type} |
72 | if exists $class_for{$type}; |
73 | require Carp; |
74 | |
75 | # this should never happen! |
76 | Carp::croak("Could not determine class for\n$token->{type}"); |
77 | } |
78 | |
79 | =head2 Boolean methods |
80 | |
81 | The following methods all return a boolean value and are to be overridden in |
82 | the appropriate subclass. |
83 | |
84 | =over 4 |
85 | |
86 | =item * C<is_plan> |
87 | |
88 | Indicates whether or not this is the test plan line. |
89 | |
90 | 1..3 |
91 | |
92 | =item * C<is_test> |
93 | |
94 | Indicates whether or not this is a test line. |
95 | |
96 | is $foo, $bar, $description; |
97 | |
98 | =item * C<is_comment> |
99 | |
100 | Indicates whether or not this is a comment. |
101 | |
102 | # this is a comment |
103 | |
104 | =item * C<is_bailout> |
105 | |
106 | Indicates whether or not this is bailout line. |
107 | |
108 | Bail out! We're out of dilithium crystals. |
109 | |
110 | =item * C<is_version> |
111 | |
112 | Indicates whether or not this is a TAP version line. |
113 | |
114 | TAP version 4 |
115 | |
116 | =item * C<is_unknown> |
117 | |
118 | Indicates whether or not the current line could be parsed. |
119 | |
120 | ... this line is junk ... |
121 | |
122 | =item * C<is_yaml> |
123 | |
124 | Indicates whether or not this is a YAML chunk. |
125 | |
126 | =back |
127 | |
128 | =cut |
129 | |
130 | ############################################################################## |
131 | |
132 | =head3 C<raw> |
133 | |
134 | print $result->raw; |
135 | |
136 | Returns the original line of text which was parsed. |
137 | |
138 | =cut |
139 | |
140 | sub raw { shift->{raw} } |
141 | |
142 | ############################################################################## |
143 | |
144 | =head3 C<type> |
145 | |
146 | my $type = $result->type; |
147 | |
148 | Returns the "type" of a token, such as C<comment> or C<test>. |
149 | |
150 | =cut |
151 | |
152 | sub type { shift->{type} } |
153 | |
154 | ############################################################################## |
155 | |
156 | =head3 C<as_string> |
157 | |
158 | print $result->as_string; |
159 | |
160 | Prints a string representation of the token. This might not be the exact |
161 | output, however. Tests will have test numbers added if not present, TODO and |
162 | SKIP directives will be capitalized and, in general, things will be cleaned |
163 | up. If you need the original text for the token, see the C<raw> method. |
164 | |
165 | =cut |
166 | |
167 | sub as_string { shift->{raw} } |
168 | |
169 | ############################################################################## |
170 | |
171 | =head3 C<is_ok> |
172 | |
173 | if ( $result->is_ok ) { ... } |
174 | |
175 | Reports whether or not a given result has passed. Anything which is B<not> a |
176 | test result returns true. This is merely provided as a convenient shortcut. |
177 | |
178 | =cut |
179 | |
180 | sub is_ok {1} |
181 | |
182 | ############################################################################## |
183 | |
184 | =head3 C<passed> |
185 | |
186 | Deprecated. Please use C<is_ok> instead. |
187 | |
188 | =cut |
189 | |
190 | sub passed { |
191 | warn 'passed() is deprecated. Please use "is_ok()"'; |
192 | shift->is_ok; |
193 | } |
194 | |
195 | ############################################################################## |
196 | |
197 | =head3 C<has_directive> |
198 | |
199 | if ( $result->has_directive ) { |
200 | ... |
201 | } |
202 | |
203 | Indicates whether or not the given result has a TODO or SKIP directive. |
204 | |
205 | =cut |
206 | |
207 | sub has_directive { |
208 | my $self = shift; |
209 | return ( $self->has_todo || $self->has_skip ); |
210 | } |
211 | |
212 | ############################################################################## |
213 | |
214 | =head3 C<has_todo> |
215 | |
216 | if ( $result->has_todo ) { |
217 | ... |
218 | } |
219 | |
220 | Indicates whether or not the given result has a TODO directive. |
221 | |
222 | =cut |
223 | |
224 | sub has_todo { 'TODO' eq ( shift->{directive} || '' ) } |
225 | |
226 | ############################################################################## |
227 | |
228 | =head3 C<has_skip> |
229 | |
230 | if ( $result->has_skip ) { |
231 | ... |
232 | } |
233 | |
234 | Indicates whether or not the given result has a SKIP directive. |
235 | |
236 | =cut |
237 | |
238 | sub has_skip { 'SKIP' eq ( shift->{directive} || '' ) } |
239 | |
240 | =head3 C<set_directive> |
241 | |
242 | Set the directive associated with this token. Used internally to fake |
243 | TODO tests. |
244 | |
245 | =cut |
246 | |
247 | sub set_directive { |
248 | my ( $self, $dir ) = @_; |
249 | $self->{directive} = $dir; |
250 | } |
251 | |
252 | 1; |