local-lib5/lib/perl5/TAP/Parser/Result.pm

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