This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Move the modules, tests, prove and Changes file from lib/ to
[perl5.git] / ext / Test / Harness / lib / TAP / Parser / Result.pm
CommitLineData
b965d173
NC
1package TAP::Parser::Result;
2
3use strict;
f7c69158 4use vars qw($VERSION @ISA);
b965d173 5
f7c69158 6use TAP::Object ();
b965d173 7
f7c69158 8@ISA = 'TAP::Object';
2a7f4b9b 9
b965d173 10BEGIN {
2a7f4b9b 11
f7c69158
NC
12 # make is_* methods
13 my @attrs = qw( plan pragma test comment bailout version unknown yaml );
b965d173 14 no strict 'refs';
f7c69158 15 for my $token (@attrs) {
b965d173
NC
16 my $method = "is_$token";
17 *$method = sub { return $token eq shift->type };
18 }
19}
20
21##############################################################################
22
23=head1 NAME
24
f7c69158 25TAP::Parser::Result - Base class for TAP::Parser output objects
b965d173
NC
26
27=head1 VERSION
28
f7c69158 29Version 3.13
b965d173
NC
30
31=cut
32
f7c69158 33$VERSION = '3.13';
b965d173 34
f7c69158 35=head1 SYNOPSIS
b965d173 36
f7c69158
NC
37 # abstract class - not meany to be used directly
38 # see TAP::Parser::ResultFactory for preferred usage
b965d173 39
f7c69158
NC
40 # directly:
41 use TAP::Parser::Result;
42 my $token = {...};
43 my $result = TAP::Parser::Result->new( $token );
b965d173 44
f7c69158
NC
45=head2 DESCRIPTION
46
47This is a simple base class used by L<TAP::Parser> to store objects that
48represent the current bit of test output data from TAP (usually a single
49line). Unless you're subclassing, you probably won't need to use this module
50directly.
b965d173
NC
51
52=head2 METHODS
53
54=head3 C<new>
55
f7c69158
NC
56 # see TAP::Parser::ResultFactory for preferred usage
57
58 # to use directly:
b965d173
NC
59 my $result = TAP::Parser::Result->new($token);
60
61Returns an instance the appropriate class for the test token passed in.
62
63=cut
64
f7c69158 65# new() implementation provided by TAP::Object
b965d173 66
f7c69158
NC
67sub _initialize {
68 my ( $self, $token ) = @_;
69 if ($token) {
70
71 # make a shallow copy of the token:
72 $self->{$_} = $token->{$_} for ( keys %$token );
73 }
74 return $self;
b965d173
NC
75}
76
f7c69158
NC
77##############################################################################
78
b965d173
NC
79=head2 Boolean methods
80
81The following methods all return a boolean value and are to be overridden in
82the appropriate subclass.
83
84=over 4
85
86=item * C<is_plan>
87
88Indicates whether or not this is the test plan line.
89
90 1..3
91
2a7f4b9b
SP
92=item * C<is_pragma>
93
94Indicates whether or not this is a pragma line.
95
96 pragma +strict
97
b965d173
NC
98=item * C<is_test>
99
100Indicates whether or not this is a test line.
101
2a7f4b9b 102 ok 1 Is OK!
b965d173
NC
103
104=item * C<is_comment>
105
106Indicates whether or not this is a comment.
107
108 # this is a comment
109
110=item * C<is_bailout>
111
112Indicates whether or not this is bailout line.
113
114 Bail out! We're out of dilithium crystals.
115
116=item * C<is_version>
117
118Indicates whether or not this is a TAP version line.
119
120 TAP version 4
121
122=item * C<is_unknown>
123
124Indicates whether or not the current line could be parsed.
125
126 ... this line is junk ...
127
128=item * C<is_yaml>
129
130Indicates whether or not this is a YAML chunk.
131
132=back
133
134=cut
135
136##############################################################################
137
138=head3 C<raw>
139
140 print $result->raw;
141
142Returns the original line of text which was parsed.
143
144=cut
145
146sub raw { shift->{raw} }
147
148##############################################################################
149
150=head3 C<type>
151
152 my $type = $result->type;
153
154Returns the "type" of a token, such as C<comment> or C<test>.
155
156=cut
157
158sub type { shift->{type} }
159
160##############################################################################
161
162=head3 C<as_string>
163
164 print $result->as_string;
165
166Prints a string representation of the token. This might not be the exact
167output, however. Tests will have test numbers added if not present, TODO and
168SKIP directives will be capitalized and, in general, things will be cleaned
169up. If you need the original text for the token, see the C<raw> method.
170
171=cut
172
173sub as_string { shift->{raw} }
174
175##############################################################################
176
177=head3 C<is_ok>
178
179 if ( $result->is_ok ) { ... }
180
181Reports whether or not a given result has passed. Anything which is B<not> a
182test result returns true. This is merely provided as a convenient shortcut.
183
184=cut
185
186sub is_ok {1}
187
188##############################################################################
189
190=head3 C<passed>
191
192Deprecated. Please use C<is_ok> instead.
193
194=cut
195
196sub passed {
197 warn 'passed() is deprecated. Please use "is_ok()"';
198 shift->is_ok;
199}
200
201##############################################################################
202
203=head3 C<has_directive>
204
205 if ( $result->has_directive ) {
206 ...
207 }
208
209Indicates whether or not the given result has a TODO or SKIP directive.
210
211=cut
212
213sub has_directive {
214 my $self = shift;
215 return ( $self->has_todo || $self->has_skip );
216}
217
218##############################################################################
219
220=head3 C<has_todo>
221
222 if ( $result->has_todo ) {
223 ...
224 }
225
226Indicates whether or not the given result has a TODO directive.
227
228=cut
229
230sub has_todo { 'TODO' eq ( shift->{directive} || '' ) }
231
232##############################################################################
233
234=head3 C<has_skip>
235
236 if ( $result->has_skip ) {
237 ...
238 }
239
240Indicates whether or not the given result has a SKIP directive.
241
242=cut
243
244sub has_skip { 'SKIP' eq ( shift->{directive} || '' ) }
245
246=head3 C<set_directive>
247
248Set the directive associated with this token. Used internally to fake
249TODO tests.
250
251=cut
252
253sub set_directive {
254 my ( $self, $dir ) = @_;
255 $self->{directive} = $dir;
256}
257
2581;
f7c69158
NC
259
260=head1 SUBCLASSING
261
262Please see L<TAP::Parser/SUBCLASSING> for a subclassing overview.
263
264Remember: if you want your subclass to be automatically used by the parser,
265you'll have to register it with L<TAP::Parser::ResultFactory/register_type>.
266
267If you're creating a completely new result I<type>, you'll probably need to
268subclass L<TAP::Parser::Grammar> too, or else it'll never get used.
269
270=head2 Example
271
272 package MyResult;
273
274 use strict;
275 use vars '@ISA';
276
277 @ISA = 'TAP::Parser::Result';
278
279 # register with the factory:
280 TAP::Parser::ResultFactory->register_type( 'my_type' => __PACKAGE__ );
281
282 sub as_string { 'My results all look the same' }
283
284=head1 SEE ALSO
285
286L<TAP::Object>,
287L<TAP::Parser>,
288L<TAP::Parser::ResultFactory>,
289L<TAP::Parser::Result::Bailout>,
290L<TAP::Parser::Result::Comment>,
291L<TAP::Parser::Result::Plan>,
292L<TAP::Parser::Result::Pragma>,
293L<TAP::Parser::Result::Test>,
294L<TAP::Parser::Result::Unknown>,
295L<TAP::Parser::Result::Version>,
296L<TAP::PARSER::RESULT::YAML>,
297
298=cut