SecurityTests/regressions/inc/Test/Harness/Results.pm

   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_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;