Commit | Line | Data |
5b1ebecd |
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 | |
5078fe9d |
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 | } |
5b1ebecd |
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; |