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