[Summary view] [Print] [Text view]

   1  # -*- Mode: cperl; cperl-indent-level: 4 -*-
   2  package Test::Harness::Results;
   3  
   4  use strict;
   5  use vars qw($VERSION);
   6  $VERSION = '0.01';
   7  
   8  =head1 NAME
   9  
  10  Test::Harness::Results - object for tracking results from a single test file
  11  
  12  =head1 SYNOPSIS
  13  
  14  One Test::Harness::Results object represents the results from one
  15  test file getting analyzed.
  16  
  17  =head1 CONSTRUCTION
  18  
  19  =head2 new()
  20  
  21      my $results = new Test::Harness::Results;
  22  
  23  Create a test point object.  Typically, however, you'll not create
  24  one yourself, but access a Results object returned to you by
  25  Test::Harness::Results.
  26  
  27  =cut
  28  
  29  sub new {
  30      my $class = shift;
  31      my $self  = bless {}, $class;
  32  
  33      return $self;
  34  }
  35  
  36  =head1 ACCESSORS
  37  
  38  The following data points are defined:
  39  
  40    passing           true if the whole test is considered a pass 
  41                      (or skipped), false if its a failure
  42  
  43    exit              the exit code of the test run, if from a file
  44    wait              the wait code of the test run, if from a file
  45  
  46    max               total tests which should have been run
  47    seen              total tests actually seen
  48    skip_all          if the whole test was skipped, this will 
  49                        contain the reason.
  50  
  51    ok                number of tests which passed 
  52                        (including todo and skips)
  53  
  54    todo              number of todo tests seen
  55    bonus             number of todo tests which 
  56                        unexpectedly passed
  57  
  58    skip              number of tests skipped
  59  
  60  So a successful test should have max == seen == ok.
  61  
  62  
  63  There is one final item, the details.
  64  
  65    details           an array ref reporting the result of 
  66                      each test looks like this:
  67  
  68      $results{details}[$test_num - 1] = 
  69              { ok          => is the test considered ok?
  70                actual_ok   => did it literally say 'ok'?
  71                name        => name of the test (if any)
  72                diagnostics => test diagnostics (if any)
  73                type        => 'skip' or 'todo' (if any)
  74                reason      => reason for the above (if any)
  75              };
  76  
  77  Element 0 of the details is test #1.  I tried it with element 1 being
  78  #1 and 0 being empty, this is less awkward.
  79  
  80  
  81  Each of the following fields has a getter and setter method.
  82  
  83  =over 4
  84  
  85  =item * wait
  86  
  87  =item * exit
  88  
  89  =cut
  90  
  91  sub set_wait { my $self = shift; $self->{wait} = shift }
  92  sub wait {
  93      my $self = shift;
  94      return $self->{wait} || 0;
  95  }
  96  
  97  sub set_skip_all { my $self = shift; $self->{skip_all} = shift }
  98  sub skip_all {
  99      my $self = shift;
 100      return $self->{skip_all};
 101  }
 102  
 103  sub inc_max { my $self = shift; $self->{max} += (@_ ? shift : 1) }
 104  sub max {
 105      my $self = shift;
 106      return $self->{max} || 0;
 107  }
 108  
 109  sub set_passing { my $self = shift; $self->{passing} = shift }
 110  sub passing {
 111      my $self = shift;
 112      return $self->{passing} || 0;
 113  }
 114  
 115  sub inc_ok { my $self = shift; $self->{ok} += (@_ ? shift : 1) }
 116  sub ok {
 117      my $self = shift;
 118      return $self->{ok} || 0;
 119  }
 120  
 121  sub set_exit { 
 122      my $self = shift; 
 123      if ($^O eq 'VMS') {
 124          eval {
 125              use vmsish q(status);
 126              $self->{exit} = shift;  # must be in same scope as pragma
 127          }
 128      }
 129      else {
 130          $self->{exit} = shift;
 131      }
 132  }
 133  sub exit {
 134      my $self = shift;
 135      return $self->{exit} || 0;
 136  }
 137  
 138  sub inc_bonus { my $self = shift; $self->{bonus}++ }
 139  sub bonus {
 140      my $self = shift;
 141      return $self->{bonus} || 0;
 142  }
 143  
 144  sub set_skip_reason { my $self = shift; $self->{skip_reason} = shift }
 145  sub skip_reason {
 146      my $self = shift;
 147      return $self->{skip_reason} || 0;
 148  }
 149  
 150  sub inc_skip { my $self = shift; $self->{skip}++ }
 151  sub skip {
 152      my $self = shift;
 153      return $self->{skip} || 0;
 154  }
 155  
 156  sub inc_todo { my $self = shift; $self->{todo}++ }
 157  sub todo {
 158      my $self = shift;
 159      return $self->{todo} || 0;
 160  }
 161  
 162  sub inc_seen { my $self = shift; $self->{seen}++ }
 163  sub seen {
 164      my $self = shift;
 165      return $self->{seen} || 0;
 166  }
 167  
 168  sub set_details {
 169      my $self = shift;
 170      my $index = shift;
 171      my $details = shift;
 172  
 173      my $array = ($self->{details} ||= []);
 174      $array->[$index-1] = $details;
 175  }
 176  
 177  sub details {
 178      my $self = shift;
 179      return $self->{details} || [];
 180  }
 181  
 182  1;