lib/TAP/Parser/Result/Test.pm

   1 package TAP::Parser::Result::Test;
   2
   3 use strict;
   4
   5 use vars qw($VERSION @ISA);
   6 use TAP::Parser::Result;
   7 @ISA = 'TAP::Parser::Result';
   8
   9 use vars qw($VERSION);
  10
  11 =head1 NAME
  12
  13 TAP::Parser::Result::Test - Test result token.
  14
  15 =head1 VERSION
  16
  17 Version 3.05
  18
  19 =cut
  20
  21 $VERSION = '3.05';
  22
  23 =head1 DESCRIPTION
  24
  25 This is a subclass of L<TAP::Parser::Result>.  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 L<TAP::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<ok>
  44
  45   my $ok = $result->ok;
  46
  47 Returns the literal text of the C<ok> or C<not ok> status.
  48
  49 =cut
  50
  51 sub ok { shift->{ok} }
  52
  53 ##############################################################################
  54
  55 =head3 C<number>
  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 sub number { shift->{test_num} }
  65
  66 sub _number {
  67     my ( $self, $number ) = @_;
  68     $self->{test_num} = $number;
  69 }
  70
  71 ##############################################################################
  72
  73 =head3 C<description>
  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 sub description { shift->{description} }
  83
  84 ##############################################################################
  85
  86 =head3 C<directive>
  87
  88   my $directive = $result->directive;
  89
  90 Returns either C<TODO> or C<SKIP> if either directive was present for a test
  91 line.
  92
  93 =cut
  94
  95 sub directive { shift->{directive} }
  96
  97 ##############################################################################
  98
  99 =head3 C<explanation>
 100
 101   my $explanation = $result->explanation;
 102
 103 If a test had either a C<TODO> or C<SKIP> 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<not enough acid>.
 109
 110 =cut
 111
 112 sub explanation { shift->{explanation} }
 113
 114 ##############################################################################
 115
 116 =head3 C<is_ok>
 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<is_unplanned>.
 125
 126 =cut
 127
 128 sub is_ok {
 129     my $self = shift;
 130
 131     return if $self->is_unplanned;
 132
 133     # TODO directives reverse the sense of a test.
 134     return $self->has_todo ? 1 : $self->ok !~ /not/;
 135 }
 136
 137 ##############################################################################
 138
 139 =head3 C<is_actual_ok>
 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     my $self = shift;
 150     return $self->{ok} !~ /not/;
 151 }
 152
 153 ##############################################################################
 154
 155 =head3 C<actual_passed>
 156
 157 Deprecated.  Please use C<is_actual_ok> instead.
 158
 159 =cut
 160
 161 sub actual_passed {
 162     warn 'actual_passed() is deprecated.  Please use "is_actual_ok()"';
 163     goto &is_actual_ok;
 164 }
 165
 166 ##############################################################################
 167
 168 =head3 C<todo_passed>
 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     my $self = shift;
 184     return $self->has_todo && $self->is_actual_ok;
 185 }
 186
 187 ##############################################################################
 188
 189 =head3 C<todo_failed>
 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<todo_passed>.
 195
 196 =cut
 197
 198 sub todo_failed {
 199     warn 'todo_failed() is deprecated.  Please use "todo_passed()"';
 200     goto &todo_passed;
 201 }
 202
 203 ##############################################################################
 204
 205 =head3 C<has_skip>
 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<has_todo>
 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<as_string>
 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<raw> method.
 228
 229 =cut
 230
 231 sub as_string {
 232     my $self   = shift;
 233     my $string = $self->ok . " " . $self->number;
 234     if ( my $description = $self->description ) {
 235         $string .= " $description";
 236     }
 237     if ( my $directive = $self->directive ) {
 238         my $explanation = $self->explanation;
 239         $string .= " # $directive $explanation";
 240     }
 241     return $string;
 242 }
 243
 244 ##############################################################################
 245
 246 =head3 C<is_unplanned>
 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<always> return false for C<is_ok>,
 253 regardless of whether or not the test C<has_todo>.
 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     my $self = shift;
 269     return ( $self->{unplanned} || '' ) unless @_;
 270     $self->{unplanned} = !!shift;
 271     return $self;
 272 }
 273
 274 1;