1# -*- Mode: cperl; cperl-indent-level: 4 -*-
2package Test::Harness::Results;
3
4use strict;
5use vars qw($VERSION);
6$VERSION = '0.01_01';
7
8=head1 NAME
9
10Test::Harness::Results - object for tracking results from a single test file
11
12=head1 SYNOPSIS
13
14One Test::Harness::Results object represents the results from one
15test file getting analyzed.
16
17=head1 CONSTRUCTION
18
19=head2 new()
20
21    my $results = new Test::Harness::Results;
22
23Create a test point object.  Typically, however, you'll not create
24one yourself, but access a Results object returned to you by
25Test::Harness::Results.
26
27=cut
28
29sub new {
30    my $class = shift;
31    my $self  = bless {}, $class;
32
33    return $self;
34}
35
36=head1 ACCESSORS
37
38The 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
60So a successful test should have max == seen == ok.
61
62
63There 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
77Element 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
81Each 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
91sub set_wait { my $self = shift; $self->{wait} = shift }
92sub wait {
93    my $self = shift;
94    return $self->{wait} || 0;
95}
96
97sub set_skip_all { my $self = shift; $self->{skip_all} = shift }
98sub skip_all {
99    my $self = shift;
100    return $self->{skip_all};
101}
102
103sub inc_max { my $self = shift; $self->{max} += (@_ ? shift : 1) }
104sub max {
105    my $self = shift;
106    return $self->{max} || 0;
107}
108
109sub set_passing { my $self = shift; $self->{passing} = shift }
110sub passing {
111    my $self = shift;
112    return $self->{passing} || 0;
113}
114
115sub inc_ok { my $self = shift; $self->{ok} += (@_ ? shift : 1) }
116sub ok {
117    my $self = shift;
118    return $self->{ok} || 0;
119}
120
121sub 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}
133sub exit {
134    my $self = shift;
135    return $self->{exit} || 0;
136}
137
138sub inc_bonus { my $self = shift; $self->{bonus}++ }
139sub bonus {
140    my $self = shift;
141    return $self->{bonus} || 0;
142}
143
144sub set_skip_reason { my $self = shift; $self->{skip_reason} = shift }
145sub skip_reason {
146    my $self = shift;
147    return $self->{skip_reason} || 0;
148}
149
150sub inc_skip { my $self = shift; $self->{skip}++ }
151sub skip {
152    my $self = shift;
153    return $self->{skip} || 0;
154}
155
156sub inc_todo { my $self = shift; $self->{todo}++ }
157sub todo {
158    my $self = shift;
159    return $self->{todo} || 0;
160}
161
162sub inc_seen { my $self = shift; $self->{seen}++ }
163sub seen {
164    my $self = shift;
165    return $self->{seen} || 0;
166}
167
168sub 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
177sub details {
178    my $self = shift;
179    return $self->{details} || [];
180}
181
1821;
183