| line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
|
1
|
|
|
|
|
|
|
# |
|
2
|
|
|
|
|
|
|
# Test::Conditions.pm |
|
3
|
|
|
|
|
|
|
# |
|
4
|
|
|
|
|
|
|
# This module allows you to set and clear an arbitrary set of conditions tagged by an arbitrary |
|
5
|
|
|
|
|
|
|
# set of labels. Its purpose is to facilitate testing large data structures, for example trees |
|
6
|
|
|
|
|
|
|
# and lists, without generating enormous numbers of individual tests. Instead, you can create a |
|
7
|
|
|
|
|
|
|
# Test::Conditions instance, and then run through the various nodes in the data structure running |
|
8
|
|
|
|
|
|
|
# a series of checks on each node. When you are finished, you can execute a single test which will |
|
9
|
|
|
|
|
|
|
# fail if any unexpected conditions were flagged and succeed otherwise. |
|
10
|
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
package Test::Conditions; |
|
13
|
|
|
|
|
|
|
|
|
14
|
3
|
|
|
3
|
|
204654
|
use strict; |
|
|
3
|
|
|
|
|
25
|
|
|
|
3
|
|
|
|
|
98
|
|
|
15
|
|
|
|
|
|
|
|
|
16
|
3
|
|
|
3
|
|
14
|
use Carp qw(croak); |
|
|
3
|
|
|
|
|
3
|
|
|
|
3
|
|
|
|
|
165
|
|
|
17
|
3
|
|
|
3
|
|
18
|
use Test::More; |
|
|
3
|
|
|
|
|
4
|
|
|
|
3
|
|
|
|
|
15
|
|
|
18
|
3
|
|
|
3
|
|
672
|
use Scalar::Util qw(reftype); |
|
|
3
|
|
|
|
|
4
|
|
|
|
3
|
|
|
|
|
7954
|
|
|
19
|
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
our $VERSION = '0.83'; |
|
21
|
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
# If the variable $TEST_INVERT is set, then invert all tests. If either $TEST_INVERT or |
|
24
|
|
|
|
|
|
|
# $TEST_OUTPUT is set, then direct all diagnostic output to $TEST_DIAG. This is necessary for |
|
25
|
|
|
|
|
|
|
# the purpose of testing this module. |
|
26
|
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
our $TEST_INVERT = 0; |
|
28
|
|
|
|
|
|
|
our $TEST_OUTPUT = 0; |
|
29
|
|
|
|
|
|
|
our $TEST_DIAG = ''; |
|
30
|
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
# new ( ) |
|
33
|
|
|
|
|
|
|
# |
|
34
|
|
|
|
|
|
|
# Create a new Test::Conditions object. |
|
35
|
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
sub new { |
|
37
|
|
|
|
|
|
|
|
|
38
|
16
|
|
|
16
|
1
|
29021
|
my ( $class, $dummy ) = @_; |
|
39
|
|
|
|
|
|
|
|
|
40
|
16
|
50
|
|
|
|
50
|
croak "you may not specify any arguments to this call" if defined $dummy; |
|
41
|
|
|
|
|
|
|
|
|
42
|
16
|
|
|
|
|
87
|
my $new = { default_limit => 0, |
|
43
|
|
|
|
|
|
|
max => { }, |
|
44
|
|
|
|
|
|
|
expect => { }, |
|
45
|
|
|
|
|
|
|
label => { }, |
|
46
|
|
|
|
|
|
|
count => { }, |
|
47
|
|
|
|
|
|
|
tested => { }, |
|
48
|
|
|
|
|
|
|
}; |
|
49
|
|
|
|
|
|
|
|
|
50
|
16
|
|
|
|
|
33
|
bless $new, $class; |
|
51
|
|
|
|
|
|
|
|
|
52
|
16
|
|
|
|
|
80
|
return $new; |
|
53
|
|
|
|
|
|
|
} |
|
54
|
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
# limit_max ( condition => limit ) |
|
57
|
|
|
|
|
|
|
# |
|
58
|
|
|
|
|
|
|
# Set the maximum number of times the specified condition can be flagged before it causes ok_all |
|
59
|
|
|
|
|
|
|
# to fail. The default for every condition is zero. If you want to specify limits for more than |
|
60
|
|
|
|
|
|
|
# one condition, you can pass in a hash ref whose keys are condition names and whose values are |
|
61
|
|
|
|
|
|
|
# nonnegative integers. If the condition name is 'DEFAULT' then this limit will become the default |
|
62
|
|
|
|
|
|
|
# for every condition. |
|
63
|
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
sub limit_max { |
|
65
|
|
|
|
|
|
|
|
|
66
|
5
|
|
|
5
|
1
|
29
|
my ($tc, $condition, $limit) = @_; |
|
67
|
|
|
|
|
|
|
|
|
68
|
|
|
|
|
|
|
# If the first argument is a hashref, set the specified limit for every key. The key values |
|
69
|
|
|
|
|
|
|
# must be nonnegative integers. |
|
70
|
|
|
|
|
|
|
|
|
71
|
5
|
100
|
66
|
|
|
30
|
if ( ref $condition && reftype $condition eq 'HASH' ) |
|
72
|
|
|
|
|
|
|
{ |
|
73
|
1
|
50
|
33
|
|
|
5
|
croak "if the first argument is a hashref you may not specify a second one" |
|
74
|
|
|
|
|
|
|
if defined $limit && $limit ne ''; |
|
75
|
|
|
|
|
|
|
|
|
76
|
1
|
|
|
|
|
3
|
foreach my $key ( keys %$condition ) |
|
77
|
|
|
|
|
|
|
{ |
|
78
|
2
|
50
|
33
|
|
|
9
|
croak "invalid condition key '$key'" unless $key ne '' && $key !~ /^\d+$/; |
|
79
|
|
|
|
|
|
|
croak "the limit value for '$key' must be a nonnegative integer" |
|
80
|
2
|
50
|
33
|
|
|
15
|
unless defined $condition->{$key} && $condition->{$key} =~ /^\d+$/; |
|
81
|
|
|
|
|
|
|
|
|
82
|
2
|
50
|
|
|
|
4
|
if ( $key eq 'DEFAULT' ) |
|
83
|
|
|
|
|
|
|
{ |
|
84
|
0
|
|
|
|
|
0
|
$tc->{default_limit} = $limit; |
|
85
|
|
|
|
|
|
|
} |
|
86
|
|
|
|
|
|
|
|
|
87
|
|
|
|
|
|
|
else |
|
88
|
|
|
|
|
|
|
{ |
|
89
|
2
|
|
|
|
|
6
|
$tc->{max}{$key} = $condition->{$key}; |
|
90
|
|
|
|
|
|
|
} |
|
91
|
|
|
|
|
|
|
} |
|
92
|
|
|
|
|
|
|
} |
|
93
|
|
|
|
|
|
|
|
|
94
|
|
|
|
|
|
|
# Otherwise, the caller must pass a non-empty key and a non-negative integer value. |
|
95
|
|
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
else |
|
97
|
|
|
|
|
|
|
{ |
|
98
|
4
|
|
50
|
|
|
9
|
$condition ||= ''; |
|
99
|
4
|
50
|
33
|
|
|
36
|
croak "invalid condition key '$condition'" unless defined $condition && $condition ne '' && $condition !~ /^\d+$/; |
|
|
|
|
33
|
|
|
|
|
|
100
|
4
|
50
|
33
|
|
|
30
|
croak "the limit value must be a nonnegative integer" unless defined $limit && $limit =~ /^\d+$/; |
|
101
|
|
|
|
|
|
|
|
|
102
|
4
|
50
|
|
|
|
13
|
if ( $condition eq 'DEFAULT' ) |
|
103
|
|
|
|
|
|
|
{ |
|
104
|
0
|
|
|
|
|
0
|
$tc->{default_limit} = $limit; |
|
105
|
|
|
|
|
|
|
} |
|
106
|
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
else |
|
108
|
|
|
|
|
|
|
{ |
|
109
|
4
|
|
|
|
|
15
|
$tc->{max}{$condition} = $limit; |
|
110
|
|
|
|
|
|
|
} |
|
111
|
|
|
|
|
|
|
} |
|
112
|
|
|
|
|
|
|
} |
|
113
|
|
|
|
|
|
|
|
|
114
|
|
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
# get_limit ( key ) |
|
116
|
|
|
|
|
|
|
# |
|
117
|
|
|
|
|
|
|
# Get the limit if any that was set for the specified key. If there is none, and if a default |
|
118
|
|
|
|
|
|
|
# limit was set, return that. Otherwise, return 0. |
|
119
|
|
|
|
|
|
|
|
|
120
|
|
|
|
|
|
|
sub get_limit { |
|
121
|
|
|
|
|
|
|
|
|
122
|
44
|
|
|
44
|
0
|
68
|
my ($tc, $key) = @_; |
|
123
|
|
|
|
|
|
|
|
|
124
|
44
|
100
|
66
|
|
|
160
|
return $tc->{max}{$key} if defined $key && defined $tc->{max}{$key}; |
|
125
|
31
|
|
|
|
|
49
|
return $tc->{default_limit}; |
|
126
|
|
|
|
|
|
|
} |
|
127
|
|
|
|
|
|
|
|
|
128
|
|
|
|
|
|
|
|
|
129
|
|
|
|
|
|
|
# expect_min ( condition => limit ) |
|
130
|
|
|
|
|
|
|
# |
|
131
|
|
|
|
|
|
|
# Set the minimum number of times the specified condition must be flagged in order for |
|
132
|
|
|
|
|
|
|
# ok_all to succeed. The default for every condition is zero. If you want to specify limits for |
|
133
|
|
|
|
|
|
|
# more than one condition, you can pass in a hash ref whose keys are condition names and whose |
|
134
|
|
|
|
|
|
|
# values are nonnegative integers. |
|
135
|
|
|
|
|
|
|
|
|
136
|
|
|
|
|
|
|
sub expect_min { |
|
137
|
|
|
|
|
|
|
|
|
138
|
13
|
|
|
13
|
1
|
48
|
my ($tc, $condition, $limit) = @_; |
|
139
|
|
|
|
|
|
|
|
|
140
|
|
|
|
|
|
|
# If the first argument is a hashref, set the specified limit for every key. The key values |
|
141
|
|
|
|
|
|
|
# must be nonnegative integers. |
|
142
|
|
|
|
|
|
|
|
|
143
|
13
|
100
|
66
|
|
|
44
|
if ( ref $condition && reftype $condition eq 'HASH' ) |
|
144
|
|
|
|
|
|
|
{ |
|
145
|
1
|
50
|
33
|
|
|
4
|
croak "if the first argument is a hashref you may not specify a second one" |
|
146
|
|
|
|
|
|
|
if defined $limit && $limit ne ''; |
|
147
|
|
|
|
|
|
|
|
|
148
|
1
|
|
|
|
|
4
|
foreach my $key ( keys %$condition ) |
|
149
|
|
|
|
|
|
|
{ |
|
150
|
2
|
50
|
33
|
|
|
9
|
croak "invalid condition key '$key'" unless $key ne '' && $key !~ /^\d+$/; |
|
151
|
|
|
|
|
|
|
croak "the limit value for '$key' must be a nonnegative integer" |
|
152
|
2
|
50
|
33
|
|
|
12
|
unless defined $condition->{$key} && $condition->{$key} =~ /^\d+$/; |
|
153
|
|
|
|
|
|
|
|
|
154
|
2
|
|
|
|
|
4
|
$tc->{expect}{$key} = $condition->{$key}; |
|
155
|
|
|
|
|
|
|
} |
|
156
|
|
|
|
|
|
|
} |
|
157
|
|
|
|
|
|
|
|
|
158
|
|
|
|
|
|
|
# Otherwise, the caller must pass a non-empty key and a non-negative integer value. |
|
159
|
|
|
|
|
|
|
|
|
160
|
|
|
|
|
|
|
else |
|
161
|
|
|
|
|
|
|
{ |
|
162
|
12
|
|
50
|
|
|
24
|
$condition ||= ''; |
|
163
|
12
|
50
|
33
|
|
|
95
|
croak "invalid condition key '$condition'" unless defined $condition && $condition ne '' && $condition !~ /^\d+$/; |
|
|
|
|
33
|
|
|
|
|
|
164
|
12
|
50
|
33
|
|
|
105
|
croak "the limit value must be a nonnegative integer" unless defined $limit && $limit =~ /^\d+$/; |
|
165
|
|
|
|
|
|
|
|
|
166
|
12
|
|
|
|
|
45
|
$tc->{expect}{$condition} = $limit; |
|
167
|
|
|
|
|
|
|
} |
|
168
|
|
|
|
|
|
|
|
|
169
|
|
|
|
|
|
|
# foreach my $k ( keys %expect ) |
|
170
|
|
|
|
|
|
|
# { |
|
171
|
|
|
|
|
|
|
# croak "bad key '$k'" unless defined $k && $k ne ''; |
|
172
|
|
|
|
|
|
|
# croak "odd number of arguments or undefined argument" unless defined $expect{$k}; |
|
173
|
|
|
|
|
|
|
# croak "expect values must be nonnegative integers" unless $expect{$k} =~ /^\d+$/; |
|
174
|
|
|
|
|
|
|
# } |
|
175
|
|
|
|
|
|
|
|
|
176
|
|
|
|
|
|
|
# foreach my $k ( keys %expect ) |
|
177
|
|
|
|
|
|
|
# { |
|
178
|
|
|
|
|
|
|
# $tc->{expect}{$k} = $expect{$k}; |
|
179
|
|
|
|
|
|
|
# } |
|
180
|
|
|
|
|
|
|
} |
|
181
|
|
|
|
|
|
|
|
|
182
|
|
|
|
|
|
|
|
|
183
|
|
|
|
|
|
|
# expect ( key ... ) |
|
184
|
|
|
|
|
|
|
# |
|
185
|
|
|
|
|
|
|
# The specified condition(s) must all be set in order for ok_all to succeed. This is equivalent to |
|
186
|
|
|
|
|
|
|
# calling expect_min( key => 1 ) for each key. |
|
187
|
|
|
|
|
|
|
|
|
188
|
|
|
|
|
|
|
sub expect { |
|
189
|
|
|
|
|
|
|
|
|
190
|
5
|
|
|
5
|
1
|
3596
|
my ($tc, @expect) = @_; |
|
191
|
|
|
|
|
|
|
|
|
192
|
5
|
|
|
|
|
39
|
foreach my $key ( @expect ) |
|
193
|
|
|
|
|
|
|
{ |
|
194
|
8
|
50
|
33
|
|
|
46
|
next unless defined $key && $key ne ''; |
|
195
|
8
|
|
|
|
|
27
|
$tc->expect_min($key, 1); |
|
196
|
|
|
|
|
|
|
} |
|
197
|
|
|
|
|
|
|
|
|
198
|
|
|
|
|
|
|
# my %e = map { $_ => 1 } @expect; |
|
199
|
|
|
|
|
|
|
|
|
200
|
|
|
|
|
|
|
# $tc->expect_min(\%e); |
|
201
|
|
|
|
|
|
|
} |
|
202
|
|
|
|
|
|
|
|
|
203
|
|
|
|
|
|
|
|
|
204
|
|
|
|
|
|
|
# get_expect ( key ) |
|
205
|
|
|
|
|
|
|
# |
|
206
|
|
|
|
|
|
|
# If the specified condition is expected, return its minimum limit. Otherwise, return 0. |
|
207
|
|
|
|
|
|
|
|
|
208
|
|
|
|
|
|
|
sub get_expect { |
|
209
|
|
|
|
|
|
|
|
|
210
|
50
|
|
|
50
|
0
|
76
|
my ($tc, $key) = @_; |
|
211
|
|
|
|
|
|
|
|
|
212
|
50
|
100
|
66
|
|
|
178
|
return $tc->{expect}{$key} if defined $key && defined $tc->{expect}{$key}; |
|
213
|
15
|
|
|
|
|
28
|
return 0; |
|
214
|
|
|
|
|
|
|
} |
|
215
|
|
|
|
|
|
|
|
|
216
|
|
|
|
|
|
|
|
|
217
|
|
|
|
|
|
|
# set ( key ) |
|
218
|
|
|
|
|
|
|
# |
|
219
|
|
|
|
|
|
|
# Set the specified condition. This will cause ok_all to fail unless the condition is expected. |
|
220
|
|
|
|
|
|
|
|
|
221
|
|
|
|
|
|
|
sub set { |
|
222
|
|
|
|
|
|
|
|
|
223
|
84
|
|
|
84
|
1
|
1931
|
my ($tc, $key) = @_; |
|
224
|
|
|
|
|
|
|
|
|
225
|
84
|
50
|
33
|
|
|
256
|
croak "you must specify a non-empty key" unless defined $key && $key ne ''; |
|
226
|
|
|
|
|
|
|
|
|
227
|
|
|
|
|
|
|
# If the condition was previously set and subsequently tested, then reset all of the |
|
228
|
|
|
|
|
|
|
# attributes associated with this key. |
|
229
|
|
|
|
|
|
|
|
|
230
|
84
|
100
|
|
|
|
196
|
if ( $tc->{tested}{$key} ) |
|
231
|
|
|
|
|
|
|
{ |
|
232
|
8
|
|
|
|
|
12
|
delete $tc->{label}{$key}; |
|
233
|
8
|
|
|
|
|
10
|
delete $tc->{count}{$key}; |
|
234
|
8
|
|
|
|
|
12
|
delete $tc->{tested}{$key}; |
|
235
|
|
|
|
|
|
|
} |
|
236
|
|
|
|
|
|
|
|
|
237
|
|
|
|
|
|
|
# Record that the condition indicated by this key has been set. |
|
238
|
|
|
|
|
|
|
|
|
239
|
84
|
|
|
|
|
205
|
$tc->{set}{$key} = 1; |
|
240
|
|
|
|
|
|
|
} |
|
241
|
|
|
|
|
|
|
|
|
242
|
|
|
|
|
|
|
|
|
243
|
|
|
|
|
|
|
# clear ( key ) |
|
244
|
|
|
|
|
|
|
# |
|
245
|
|
|
|
|
|
|
# Clear the specified condition. This will cause ok_all to fail if the condition is expected. If |
|
246
|
|
|
|
|
|
|
# the condition is not expected, then it will no longer cause ok_all to fail. |
|
247
|
|
|
|
|
|
|
|
|
248
|
|
|
|
|
|
|
sub clear { |
|
249
|
|
|
|
|
|
|
|
|
250
|
9
|
|
|
9
|
1
|
4833
|
my ($tc, $key) = @_; |
|
251
|
|
|
|
|
|
|
|
|
252
|
9
|
50
|
33
|
|
|
37
|
croak "you must specify a non-empty key" unless defined $key && $key ne ''; |
|
253
|
|
|
|
|
|
|
|
|
254
|
|
|
|
|
|
|
# If the specified condition was previously tested, then reset that attribute. |
|
255
|
|
|
|
|
|
|
|
|
256
|
9
|
50
|
|
|
|
22
|
if ( $tc->{tested}{$key} ) |
|
257
|
|
|
|
|
|
|
{ |
|
258
|
0
|
|
|
|
|
0
|
delete $tc->{tested}{$key}; |
|
259
|
|
|
|
|
|
|
} |
|
260
|
|
|
|
|
|
|
|
|
261
|
|
|
|
|
|
|
# Record that this condition has been cleared. |
|
262
|
|
|
|
|
|
|
|
|
263
|
9
|
|
|
|
|
16
|
$tc->{set}{$key} = 0; |
|
264
|
|
|
|
|
|
|
|
|
265
|
|
|
|
|
|
|
# Delete all of the other attributes associated with this key. |
|
266
|
|
|
|
|
|
|
|
|
267
|
9
|
|
|
|
|
15
|
delete $tc->{count}{$key}; |
|
268
|
9
|
|
|
|
|
18
|
delete $tc->{label}{$key}; |
|
269
|
|
|
|
|
|
|
} |
|
270
|
|
|
|
|
|
|
|
|
271
|
|
|
|
|
|
|
|
|
272
|
|
|
|
|
|
|
# flag ( key, [label] ) |
|
273
|
|
|
|
|
|
|
# |
|
274
|
|
|
|
|
|
|
# This method sets the condition associated with the specified key, and also keeps track of how |
|
275
|
|
|
|
|
|
|
# many times it has been called for each key. This provides more accurate information than just |
|
276
|
|
|
|
|
|
|
# set/clear. If a label is specified, then it is stored and will later be reported when ok_all is |
|
277
|
|
|
|
|
|
|
# called. Only the first label specified for a given key is recorded, but this allows the tester |
|
278
|
|
|
|
|
|
|
# to find at least one item for which the condition was flagged. |
|
279
|
|
|
|
|
|
|
|
|
280
|
|
|
|
|
|
|
sub flag { |
|
281
|
|
|
|
|
|
|
|
|
282
|
70
|
|
|
70
|
1
|
6348
|
my ($tc, $key, $label) = @_; |
|
283
|
|
|
|
|
|
|
|
|
284
|
70
|
50
|
33
|
|
|
237
|
croak "you must specify a non-empty key" unless defined $key && $key ne ''; |
|
285
|
|
|
|
|
|
|
|
|
286
|
|
|
|
|
|
|
# Set the specified condition, and also increment the count. If a label is specified, and if |
|
287
|
|
|
|
|
|
|
# no label has been recorded yet for this condition, then record it. |
|
288
|
|
|
|
|
|
|
|
|
289
|
70
|
|
|
|
|
142
|
$tc->set($key); |
|
290
|
|
|
|
|
|
|
|
|
291
|
70
|
|
|
|
|
97
|
$tc->{count}{$key}++; |
|
292
|
70
|
100
|
100
|
|
|
276
|
$tc->{label}{$key} = $label if ! defined $tc->{label}{$key} && defined $label && $label ne ''; |
|
|
|
|
66
|
|
|
|
|
|
293
|
|
|
|
|
|
|
} |
|
294
|
|
|
|
|
|
|
|
|
295
|
|
|
|
|
|
|
|
|
296
|
|
|
|
|
|
|
# decrement ( key, [label] ) |
|
297
|
|
|
|
|
|
|
# |
|
298
|
|
|
|
|
|
|
# This method reverses the effect of 'flag'. If the condition has previously been flagged, its |
|
299
|
|
|
|
|
|
|
# count will be decremented. If the count reaches zero, the condition will be cleared. If a label |
|
300
|
|
|
|
|
|
|
# is given and if it matches the label stored for this condition, then the stored label will be |
|
301
|
|
|
|
|
|
|
# cleared. |
|
302
|
|
|
|
|
|
|
# |
|
303
|
|
|
|
|
|
|
# If the condition was set with 'set' but was never flagged, this method will have no effect. |
|
304
|
|
|
|
|
|
|
|
|
305
|
|
|
|
|
|
|
sub decrement { |
|
306
|
|
|
|
|
|
|
|
|
307
|
9
|
|
|
9
|
1
|
25
|
my ($tc, $key, $label) = @_; |
|
308
|
|
|
|
|
|
|
|
|
309
|
9
|
50
|
33
|
|
|
47
|
croak "you must specify a non-empty key" unless defined $key && $key ne ''; |
|
310
|
|
|
|
|
|
|
|
|
311
|
|
|
|
|
|
|
# If there is a non-zero count for this condition, decrement it. If the count reaches zero, |
|
312
|
|
|
|
|
|
|
# clear the condition but leave the count as '0'. |
|
313
|
|
|
|
|
|
|
|
|
314
|
9
|
50
|
33
|
|
|
33
|
if ( defined $tc->{count}{$key} && $tc->{count}{$key} > 0 ) |
|
315
|
|
|
|
|
|
|
{ |
|
316
|
9
|
|
|
|
|
19
|
$tc->{count}{$key}--; |
|
317
|
|
|
|
|
|
|
|
|
318
|
9
|
100
|
|
|
|
28
|
unless ( $tc->{count}{$key} ) |
|
319
|
|
|
|
|
|
|
{ |
|
320
|
5
|
|
|
|
|
8
|
$tc->{set}{$key} = 0; |
|
321
|
5
|
|
|
|
|
11
|
delete $tc->{label}{$key}; |
|
322
|
|
|
|
|
|
|
} |
|
323
|
|
|
|
|
|
|
} |
|
324
|
|
|
|
|
|
|
|
|
325
|
|
|
|
|
|
|
# If a label was given and matches the stored label for this condition, then clear it. |
|
326
|
|
|
|
|
|
|
|
|
327
|
9
|
100
|
100
|
|
|
33
|
if ( defined $tc->{label}{$key} && defined $label && $tc->{label}{$key} eq $label ) |
|
|
|
|
66
|
|
|
|
|
|
328
|
|
|
|
|
|
|
{ |
|
329
|
1
|
|
|
|
|
10
|
delete $tc->{label}{$key}; |
|
330
|
|
|
|
|
|
|
} |
|
331
|
|
|
|
|
|
|
} |
|
332
|
|
|
|
|
|
|
|
|
333
|
|
|
|
|
|
|
|
|
334
|
|
|
|
|
|
|
# active_conditions ( ) |
|
335
|
|
|
|
|
|
|
# |
|
336
|
|
|
|
|
|
|
# Return a list of all keys which have been set but have not been tested. |
|
337
|
|
|
|
|
|
|
|
|
338
|
|
|
|
|
|
|
sub active_conditions { |
|
339
|
|
|
|
|
|
|
|
|
340
|
36
|
|
|
36
|
1
|
3642
|
my ($tc) = @_; |
|
341
|
|
|
|
|
|
|
|
|
342
|
36
|
100
|
|
|
|
90
|
return unless ref $tc->{set} eq 'HASH'; |
|
343
|
35
|
100
|
|
|
|
37
|
return grep { ! $tc->{tested}{$_} && $tc->{set}{$_} } keys %{$tc->{set}}; |
|
|
63
|
|
|
|
|
287
|
|
|
|
35
|
|
|
|
|
123
|
|
|
344
|
|
|
|
|
|
|
} |
|
345
|
|
|
|
|
|
|
|
|
346
|
|
|
|
|
|
|
|
|
347
|
|
|
|
|
|
|
# expected_conditions ( ) |
|
348
|
|
|
|
|
|
|
# |
|
349
|
|
|
|
|
|
|
# Return all keys which are currently expected. |
|
350
|
|
|
|
|
|
|
|
|
351
|
|
|
|
|
|
|
sub expected_conditions { |
|
352
|
|
|
|
|
|
|
|
|
353
|
35
|
|
|
35
|
1
|
56
|
my ($tc) = @_; |
|
354
|
|
|
|
|
|
|
|
|
355
|
35
|
50
|
|
|
|
85
|
return unless ref $tc->{expect} eq 'HASH'; |
|
356
|
35
|
|
|
|
|
41
|
return grep { $tc->{expect}{$_} } keys %{$tc->{expect}}; |
|
|
35
|
|
|
|
|
77
|
|
|
|
35
|
|
|
|
|
81
|
|
|
357
|
|
|
|
|
|
|
} |
|
358
|
|
|
|
|
|
|
|
|
359
|
|
|
|
|
|
|
|
|
360
|
|
|
|
|
|
|
# all_conditions ( ) |
|
361
|
|
|
|
|
|
|
# |
|
362
|
|
|
|
|
|
|
# Return all keys which have been set or cleared. |
|
363
|
|
|
|
|
|
|
|
|
364
|
|
|
|
|
|
|
sub all_conditions { |
|
365
|
|
|
|
|
|
|
|
|
366
|
2
|
|
|
2
|
1
|
11
|
my ($tc) = @_; |
|
367
|
|
|
|
|
|
|
|
|
368
|
2
|
50
|
|
|
|
8
|
return unless ref $tc->{set} eq 'HASH'; |
|
369
|
2
|
|
|
|
|
4
|
return grep { defined $tc->{set}{$_} } keys %{$tc->{set}}; |
|
|
10
|
|
|
|
|
27
|
|
|
|
2
|
|
|
|
|
8
|
|
|
370
|
|
|
|
|
|
|
} |
|
371
|
|
|
|
|
|
|
|
|
372
|
|
|
|
|
|
|
|
|
373
|
|
|
|
|
|
|
# is_set ( key ) |
|
374
|
|
|
|
|
|
|
# |
|
375
|
|
|
|
|
|
|
# Return 1 if the specified condition has been set, 0 if it has been cleared, and undefined if it |
|
376
|
|
|
|
|
|
|
# has been neither set nor cleared. |
|
377
|
|
|
|
|
|
|
|
|
378
|
|
|
|
|
|
|
sub is_set { |
|
379
|
|
|
|
|
|
|
|
|
380
|
15
|
|
|
15
|
1
|
341
|
my ($tc, $key) = @_; |
|
381
|
|
|
|
|
|
|
|
|
382
|
15
|
|
|
|
|
44
|
return $tc->{set}{$key}; |
|
383
|
|
|
|
|
|
|
} |
|
384
|
|
|
|
|
|
|
|
|
385
|
|
|
|
|
|
|
|
|
386
|
|
|
|
|
|
|
# is_tested ( key ) |
|
387
|
|
|
|
|
|
|
# |
|
388
|
|
|
|
|
|
|
# Return 1 if the specified condition has been tested, false otherwise. |
|
389
|
|
|
|
|
|
|
|
|
390
|
|
|
|
|
|
|
sub is_tested { |
|
391
|
|
|
|
|
|
|
|
|
392
|
17
|
|
|
17
|
1
|
2635
|
my ($tc, $key) = @_; |
|
393
|
|
|
|
|
|
|
|
|
394
|
17
|
|
|
|
|
49
|
return $tc->{tested}{$key}; |
|
395
|
|
|
|
|
|
|
} |
|
396
|
|
|
|
|
|
|
|
|
397
|
|
|
|
|
|
|
|
|
398
|
|
|
|
|
|
|
# get_count ( key ) |
|
399
|
|
|
|
|
|
|
# |
|
400
|
|
|
|
|
|
|
# Return the number of times this condition has been flagged, undef if it has never been flagged. |
|
401
|
|
|
|
|
|
|
|
|
402
|
|
|
|
|
|
|
sub get_count { |
|
403
|
|
|
|
|
|
|
|
|
404
|
48
|
|
|
48
|
1
|
2560
|
my ($tc, $key) = @_; |
|
405
|
|
|
|
|
|
|
|
|
406
|
48
|
|
|
|
|
142
|
return $tc->{count}{$key}; |
|
407
|
|
|
|
|
|
|
} |
|
408
|
|
|
|
|
|
|
|
|
409
|
|
|
|
|
|
|
|
|
410
|
|
|
|
|
|
|
# get_label ( key ) |
|
411
|
|
|
|
|
|
|
# |
|
412
|
|
|
|
|
|
|
# Return the label specified for this condition, or the empty string if there is none. |
|
413
|
|
|
|
|
|
|
|
|
414
|
|
|
|
|
|
|
sub get_label { |
|
415
|
|
|
|
|
|
|
|
|
416
|
50
|
|
|
50
|
1
|
78
|
my ($tc, $key) = @_; |
|
417
|
|
|
|
|
|
|
|
|
418
|
50
|
100
|
|
|
|
144
|
return defined $tc->{label}{$key} ? $tc->{label}{$key} : ''; |
|
419
|
|
|
|
|
|
|
} |
|
420
|
|
|
|
|
|
|
|
|
421
|
|
|
|
|
|
|
|
|
422
|
|
|
|
|
|
|
# ok_all ( message ) |
|
423
|
|
|
|
|
|
|
# |
|
424
|
|
|
|
|
|
|
# This method generates a TAP event. If any unexpected conditions are set, or if any expected |
|
425
|
|
|
|
|
|
|
# conditions are not set, then the event will be a failure. Otherwise, it will be a success. The |
|
426
|
|
|
|
|
|
|
# specified message will be reported as the test name. |
|
427
|
|
|
|
|
|
|
# |
|
428
|
|
|
|
|
|
|
# Each condition that is checked as a result of this call will be marked as 'tested'. Subsequent |
|
429
|
|
|
|
|
|
|
# calls to ok_all or ok_condition will disregard this condition, unless it is subsequently |
|
430
|
|
|
|
|
|
|
# explicitly set or cleared again. However is_set, get_count, etc. will still return the proper |
|
431
|
|
|
|
|
|
|
# results. |
|
432
|
|
|
|
|
|
|
|
|
433
|
|
|
|
|
|
|
sub ok_all { |
|
434
|
|
|
|
|
|
|
|
|
435
|
33
|
|
|
33
|
1
|
2117
|
my ($tc, $message) = @_; |
|
436
|
|
|
|
|
|
|
|
|
437
|
33
|
50
|
|
|
|
57
|
croak "you must specify a message" unless $message; |
|
438
|
|
|
|
|
|
|
|
|
439
|
|
|
|
|
|
|
# By incrementing the variable indicated below, the result of 'pass' or 'fail' will be |
|
440
|
|
|
|
|
|
|
# reported as occurring on the line in the test file from which this method was called. |
|
441
|
|
|
|
|
|
|
|
|
442
|
33
|
|
|
|
|
49
|
local $Test::Builder::Level = $Test::Builder::Level + 1; |
|
443
|
|
|
|
|
|
|
|
|
444
|
33
|
|
|
|
|
41
|
my (@fail, @warn, %found); |
|
445
|
|
|
|
|
|
|
|
|
446
|
|
|
|
|
|
|
# Check each condition that was set but has not yet been tested. |
|
447
|
|
|
|
|
|
|
|
|
448
|
|
|
|
|
|
|
KEY: |
|
449
|
33
|
|
|
|
|
63
|
foreach my $k ( $tc->active_conditions ) |
|
450
|
|
|
|
|
|
|
{ |
|
451
|
35
|
|
100
|
|
|
77
|
my $count = $tc->get_count($k) || 0; |
|
452
|
35
|
|
|
|
|
70
|
my $limit = $tc->get_limit($k); |
|
453
|
35
|
|
|
|
|
62
|
my $expected = $tc->get_expect($k); |
|
454
|
35
|
|
|
|
|
61
|
my $label = $tc->get_label($k); |
|
455
|
|
|
|
|
|
|
|
|
456
|
|
|
|
|
|
|
# Mark that this condition has been tested. |
|
457
|
|
|
|
|
|
|
|
|
458
|
35
|
|
|
|
|
70
|
$tc->{tested}{$k} = 1; |
|
459
|
35
|
|
|
|
|
41
|
$found{$k} = 1; |
|
460
|
|
|
|
|
|
|
|
|
461
|
|
|
|
|
|
|
# If this condition is expected, then we can just skip to the next one. But if the minimum |
|
462
|
|
|
|
|
|
|
# limit was greater than one, then we fail unless the count matches or exceeds that |
|
463
|
|
|
|
|
|
|
# limit. And if there was a maximum limit specified, we fail if the count exceeds that. |
|
464
|
|
|
|
|
|
|
|
|
465
|
35
|
100
|
100
|
|
|
134
|
if ( $expected && ( $limit == 0 || $count <= $limit ) ) |
|
|
|
100
|
100
|
|
|
|
|
|
|
|
100
|
100
|
|
|
|
|
|
466
|
|
|
|
|
|
|
{ |
|
467
|
23
|
100
|
|
|
|
63
|
next KEY if $expected == 1; |
|
468
|
10
|
100
|
66
|
|
|
32
|
next KEY if defined $count && $count >= $expected; |
|
469
|
|
|
|
|
|
|
|
|
470
|
5
|
|
|
|
|
14
|
my $m = " Condition '$k': flagged $count instance"; |
|
471
|
5
|
100
|
|
|
|
8
|
$m .= "s" if $count != 1; |
|
472
|
5
|
|
|
|
|
12
|
$m .= ", expected at least $expected"; |
|
473
|
|
|
|
|
|
|
|
|
474
|
5
|
|
|
|
|
10
|
push @fail, $m; |
|
475
|
|
|
|
|
|
|
} |
|
476
|
|
|
|
|
|
|
|
|
477
|
|
|
|
|
|
|
# Otherwise, this condition is not expected. If there is a limit and the count does not exceed |
|
478
|
|
|
|
|
|
|
# it, we add a warning message but do not fail. |
|
479
|
|
|
|
|
|
|
|
|
480
|
|
|
|
|
|
|
elsif ( $limit && $count <= $limit ) |
|
481
|
|
|
|
|
|
|
{ |
|
482
|
4
|
|
|
|
|
11
|
my $m = " Condition '$k': flagged $count instance"; |
|
483
|
4
|
100
|
|
|
|
10
|
$m .= "s" if $count > 1; |
|
484
|
4
|
50
|
|
|
|
10
|
$m .= " [$label]" if defined $label & $label ne ''; |
|
485
|
4
|
50
|
|
|
|
10
|
$m .= " (limit $limit)" if $limit; |
|
486
|
|
|
|
|
|
|
|
|
487
|
4
|
|
|
|
|
11
|
push @warn, $m; |
|
488
|
|
|
|
|
|
|
} |
|
489
|
|
|
|
|
|
|
|
|
490
|
|
|
|
|
|
|
# If the limit was exceeded, or if no limit was specified, then the condition leads to a failure. |
|
491
|
|
|
|
|
|
|
|
|
492
|
|
|
|
|
|
|
elsif ( $count ) |
|
493
|
|
|
|
|
|
|
{ |
|
494
|
7
|
|
|
|
|
25
|
my $m = " Condition '$k': flagged $count instance"; |
|
495
|
7
|
100
|
|
|
|
20
|
$m .= "s" if $count > 1; |
|
496
|
7
|
100
|
|
|
|
30
|
$m .= " [$label]" if defined $label & $label ne ''; |
|
497
|
7
|
100
|
|
|
|
16
|
$m .= " (limit $limit)" if $limit; |
|
498
|
|
|
|
|
|
|
|
|
499
|
7
|
|
|
|
|
20
|
push @fail, $m; |
|
500
|
|
|
|
|
|
|
} |
|
501
|
|
|
|
|
|
|
|
|
502
|
|
|
|
|
|
|
# If this condition was set rather than flagged, we generate a simple failure message. |
|
503
|
|
|
|
|
|
|
|
|
504
|
|
|
|
|
|
|
else |
|
505
|
|
|
|
|
|
|
{ |
|
506
|
1
|
|
|
|
|
6
|
push @fail, " Condition '$k'"; |
|
507
|
|
|
|
|
|
|
} |
|
508
|
|
|
|
|
|
|
} |
|
509
|
|
|
|
|
|
|
|
|
510
|
|
|
|
|
|
|
# Now go through the conditions we were expecting and fail if we didn't get all of them. |
|
511
|
|
|
|
|
|
|
|
|
512
|
33
|
|
|
|
|
75
|
foreach my $k ( $tc->expected_conditions ) |
|
513
|
|
|
|
|
|
|
{ |
|
514
|
30
|
100
|
|
|
|
53
|
unless ( $found{$k} ) |
|
515
|
|
|
|
|
|
|
{ |
|
516
|
6
|
|
|
|
|
12
|
my $e = $tc->get_expect($k); |
|
517
|
|
|
|
|
|
|
|
|
518
|
6
|
100
|
|
|
|
16
|
if ( $e == 1 ) |
|
519
|
|
|
|
|
|
|
{ |
|
520
|
5
|
|
|
|
|
17
|
push @fail, " Condition '$k': not set"; |
|
521
|
|
|
|
|
|
|
} |
|
522
|
|
|
|
|
|
|
|
|
523
|
|
|
|
|
|
|
else |
|
524
|
|
|
|
|
|
|
{ |
|
525
|
1
|
|
|
|
|
4
|
push @fail, " Condition '$k': found no instances, expected at least $e"; |
|
526
|
|
|
|
|
|
|
} |
|
527
|
|
|
|
|
|
|
} |
|
528
|
|
|
|
|
|
|
} |
|
529
|
|
|
|
|
|
|
|
|
530
|
|
|
|
|
|
|
# Now, if we have accumulated any failures then fail the entire test with the specified |
|
531
|
|
|
|
|
|
|
# message. Output the individual messages as diagnostics. |
|
532
|
|
|
|
|
|
|
|
|
533
|
33
|
100
|
|
|
|
81
|
if ( @fail ) |
|
|
|
100
|
|
|
|
|
|
|
534
|
|
|
|
|
|
|
{ |
|
535
|
16
|
|
|
|
|
44
|
ok($TEST_INVERT, $message); |
|
536
|
16
|
|
|
|
|
5353
|
_diag($_) foreach @fail; |
|
537
|
|
|
|
|
|
|
|
|
538
|
16
|
50
|
|
|
|
74
|
if ( @warn ) |
|
539
|
|
|
|
|
|
|
{ |
|
540
|
0
|
|
|
|
|
0
|
_diag("This test also generated the following warnings:"); |
|
541
|
0
|
|
|
|
|
0
|
_diag($_) foreach @warn; |
|
542
|
|
|
|
|
|
|
} |
|
543
|
|
|
|
|
|
|
} |
|
544
|
|
|
|
|
|
|
|
|
545
|
|
|
|
|
|
|
# If we have warnings but no failures, then we pass the test but emit the individual warnings |
|
546
|
|
|
|
|
|
|
# as diagnostics. |
|
547
|
|
|
|
|
|
|
|
|
548
|
|
|
|
|
|
|
elsif ( @warn ) |
|
549
|
|
|
|
|
|
|
{ |
|
550
|
3
|
|
|
|
|
11
|
ok(!$TEST_INVERT, $message); |
|
551
|
3
|
|
|
|
|
1069
|
_diag("Passed test '$message' with warnings:"); |
|
552
|
3
|
|
|
|
|
10
|
_diag($_) foreach @warn; |
|
553
|
|
|
|
|
|
|
} |
|
554
|
|
|
|
|
|
|
|
|
555
|
|
|
|
|
|
|
# Otherwise, we just pass the test. |
|
556
|
|
|
|
|
|
|
|
|
557
|
|
|
|
|
|
|
else |
|
558
|
|
|
|
|
|
|
{ |
|
559
|
14
|
|
|
|
|
43
|
ok(!$TEST_INVERT, $message); |
|
560
|
|
|
|
|
|
|
} |
|
561
|
|
|
|
|
|
|
} |
|
562
|
|
|
|
|
|
|
|
|
563
|
|
|
|
|
|
|
|
|
564
|
|
|
|
|
|
|
# ok_condition ( key, message ) |
|
565
|
|
|
|
|
|
|
# |
|
566
|
|
|
|
|
|
|
# This method generates a TAP event. If the specified condition was set, or if it was expected but |
|
567
|
|
|
|
|
|
|
# not set, then the event will be a failure. Otherwise, it will be a success. The specified |
|
568
|
|
|
|
|
|
|
# message will be reported as the test name. |
|
569
|
|
|
|
|
|
|
# |
|
570
|
|
|
|
|
|
|
# The specified condition will be marked as 'tested'. Subsequent calls to ok_all or ok_condition |
|
571
|
|
|
|
|
|
|
# will disregard this condition, unless it is subsequently explicitly set or cleared |
|
572
|
|
|
|
|
|
|
# again. However is_set, get_count, etc. will still return the proper results. |
|
573
|
|
|
|
|
|
|
|
|
574
|
|
|
|
|
|
|
sub ok_condition { |
|
575
|
|
|
|
|
|
|
|
|
576
|
9
|
|
|
9
|
1
|
1671
|
my ($tc, $key, $message) = @_; |
|
577
|
|
|
|
|
|
|
|
|
578
|
9
|
50
|
|
|
|
22
|
croak "you must specify a message" unless $message; |
|
579
|
|
|
|
|
|
|
|
|
580
|
|
|
|
|
|
|
# By incrementing the variable indicated below, the result of 'pass' or 'fail' will be |
|
581
|
|
|
|
|
|
|
# reported as occurring on the line in the test file from which this method was called. |
|
582
|
|
|
|
|
|
|
|
|
583
|
9
|
|
|
|
|
16
|
local $Test::Builder::Level = $Test::Builder::Level + 1; |
|
584
|
|
|
|
|
|
|
|
|
585
|
9
|
|
|
|
|
21
|
my $set = $tc->is_set($key); |
|
586
|
9
|
|
|
|
|
26
|
my $expected = $tc->get_expect($key); |
|
587
|
9
|
|
100
|
|
|
40
|
my $count = $tc->get_count($key) || 0; |
|
588
|
9
|
|
|
|
|
36
|
my $limit = $tc->get_limit($key); |
|
589
|
9
|
|
|
|
|
18
|
my $label = $tc->get_label($key); |
|
590
|
9
|
|
|
|
|
18
|
my $tested = $tc->is_tested($key); |
|
591
|
|
|
|
|
|
|
|
|
592
|
|
|
|
|
|
|
# If an expected condition has been tested, act as though it has not been set. |
|
593
|
|
|
|
|
|
|
|
|
594
|
9
|
100
|
|
|
|
21
|
$set = 0 if $tested; |
|
595
|
|
|
|
|
|
|
|
|
596
|
|
|
|
|
|
|
# Now mark this condition as having been tested. |
|
597
|
|
|
|
|
|
|
|
|
598
|
9
|
|
|
|
|
12
|
$tc->{tested}{$key} = 1; |
|
599
|
|
|
|
|
|
|
|
|
600
|
|
|
|
|
|
|
# If this condition is expected, then we succeed if it is set and fail if it is not. But if the |
|
601
|
|
|
|
|
|
|
# expected count is not met, then we fail anyway and add a diagnostic message. |
|
602
|
|
|
|
|
|
|
|
|
603
|
9
|
100
|
33
|
|
|
28
|
if ( $expected ) |
|
|
|
100
|
33
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
604
|
|
|
|
|
|
|
{ |
|
605
|
5
|
100
|
66
|
|
|
48
|
if ( $set && ( $expected == 1 || $count >= $expected ) && ( $limit == 0 || $count <= $limit ) ) |
|
|
|
100
|
100
|
|
|
|
|
|
|
|
50
|
66
|
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
606
|
|
|
|
|
|
|
{ |
|
607
|
2
|
|
|
|
|
9
|
ok(!$TEST_INVERT, $message); |
|
608
|
|
|
|
|
|
|
} |
|
609
|
|
|
|
|
|
|
|
|
610
|
|
|
|
|
|
|
elsif ( $count > $limit ) |
|
611
|
|
|
|
|
|
|
{ |
|
612
|
2
|
|
|
|
|
6
|
ok($TEST_INVERT, $message); |
|
613
|
2
|
100
|
|
|
|
636
|
my $s = $count == 1 ? '' : 's'; |
|
614
|
2
|
|
|
|
|
17
|
_diag(" Condition '$key': flagged $count instance$s, limit $limit"); |
|
615
|
|
|
|
|
|
|
} |
|
616
|
|
|
|
|
|
|
|
|
617
|
|
|
|
|
|
|
elsif ( $expected > 1 ) |
|
618
|
|
|
|
|
|
|
{ |
|
619
|
1
|
|
|
|
|
3
|
ok($TEST_INVERT, $message); |
|
620
|
1
|
50
|
|
|
|
275
|
my $s = $count == 1 ? '' : 's'; |
|
621
|
1
|
|
|
|
|
5
|
_diag(" Condition '$key': flagged $count instance$s, expected at least $expected"); |
|
622
|
|
|
|
|
|
|
} |
|
623
|
|
|
|
|
|
|
|
|
624
|
|
|
|
|
|
|
else |
|
625
|
|
|
|
|
|
|
{ |
|
626
|
0
|
|
|
|
|
0
|
ok($TEST_INVERT, $message); |
|
627
|
|
|
|
|
|
|
} |
|
628
|
|
|
|
|
|
|
} |
|
629
|
|
|
|
|
|
|
|
|
630
|
|
|
|
|
|
|
# Otherwise, the condition is not expected. If is not set, then we pass. |
|
631
|
|
|
|
|
|
|
|
|
632
|
|
|
|
|
|
|
elsif ( ! $set ) |
|
633
|
|
|
|
|
|
|
{ |
|
634
|
3
|
|
|
|
|
13
|
ok(!$TEST_INVERT, $message); |
|
635
|
|
|
|
|
|
|
} |
|
636
|
|
|
|
|
|
|
|
|
637
|
|
|
|
|
|
|
# If the condition is set but there is a limit that was not exceeded, then we pass with a |
|
638
|
|
|
|
|
|
|
# warning message. |
|
639
|
|
|
|
|
|
|
|
|
640
|
|
|
|
|
|
|
elsif ( defined $count && defined $limit && $count <= $limit ) |
|
641
|
|
|
|
|
|
|
{ |
|
642
|
0
|
|
|
|
|
0
|
ok(!$TEST_INVERT, $message); |
|
643
|
|
|
|
|
|
|
|
|
644
|
0
|
|
|
|
|
0
|
my $m = " Condition '$key': flagged $count instance"; |
|
645
|
0
|
0
|
|
|
|
0
|
$m .= "s" if $count > 1; |
|
646
|
0
|
0
|
|
|
|
0
|
$m .= " [$label]" if defined $label & $label ne ''; |
|
647
|
0
|
0
|
|
|
|
0
|
$m .= " (limit $limit)" if $limit; |
|
648
|
|
|
|
|
|
|
|
|
649
|
0
|
|
|
|
|
0
|
_diag($m); |
|
650
|
|
|
|
|
|
|
} |
|
651
|
|
|
|
|
|
|
|
|
652
|
|
|
|
|
|
|
# Otherwise, we fail. If there was a limit which was exceeded then we generate a diagnostic |
|
653
|
|
|
|
|
|
|
# message. |
|
654
|
|
|
|
|
|
|
|
|
655
|
|
|
|
|
|
|
else |
|
656
|
|
|
|
|
|
|
{ |
|
657
|
1
|
|
|
|
|
4
|
ok($TEST_INVERT, $message); |
|
658
|
|
|
|
|
|
|
|
|
659
|
1
|
50
|
33
|
|
|
323
|
if ( $count && $limit ) |
|
660
|
|
|
|
|
|
|
{ |
|
661
|
0
|
|
|
|
|
0
|
my $m = " Condition '$key': flagged $count instance"; |
|
662
|
0
|
0
|
|
|
|
0
|
$m .= "s" if $count > 1; |
|
663
|
0
|
0
|
|
|
|
0
|
$m .= " [$label]" if defined $label & $label ne ''; |
|
664
|
0
|
|
|
|
|
0
|
$m .= " (limit $limit)"; |
|
665
|
|
|
|
|
|
|
|
|
666
|
0
|
|
|
|
|
0
|
_diag($m); |
|
667
|
|
|
|
|
|
|
} |
|
668
|
|
|
|
|
|
|
} |
|
669
|
|
|
|
|
|
|
} |
|
670
|
|
|
|
|
|
|
|
|
671
|
|
|
|
|
|
|
|
|
672
|
|
|
|
|
|
|
# _diag ( line ) |
|
673
|
|
|
|
|
|
|
# |
|
674
|
|
|
|
|
|
|
# This subroutine allows for interception of diagnostic messages for the purpose of running unit |
|
675
|
|
|
|
|
|
|
# tests on this module. |
|
676
|
|
|
|
|
|
|
|
|
677
|
|
|
|
|
|
|
sub _diag { |
|
678
|
|
|
|
|
|
|
|
|
679
|
29
|
50
|
66
|
29
|
|
107
|
if ( $TEST_INVERT || $TEST_OUTPUT ) |
|
680
|
|
|
|
|
|
|
{ |
|
681
|
29
|
|
|
|
|
99
|
$TEST_DIAG .= "$_[0]\n"; |
|
682
|
|
|
|
|
|
|
} |
|
683
|
|
|
|
|
|
|
|
|
684
|
|
|
|
|
|
|
else |
|
685
|
|
|
|
|
|
|
{ |
|
686
|
0
|
|
|
|
|
0
|
goto &diag; |
|
687
|
|
|
|
|
|
|
} |
|
688
|
|
|
|
|
|
|
} |
|
689
|
|
|
|
|
|
|
|
|
690
|
|
|
|
|
|
|
|
|
691
|
|
|
|
|
|
|
# reset_conditions ( ) |
|
692
|
|
|
|
|
|
|
# |
|
693
|
|
|
|
|
|
|
# Completely reset the status of every condition, but leave the limits in place so they can be |
|
694
|
|
|
|
|
|
|
# used to test a different set of items. |
|
695
|
|
|
|
|
|
|
|
|
696
|
|
|
|
|
|
|
sub reset_conditions { |
|
697
|
|
|
|
|
|
|
|
|
698
|
15
|
|
|
15
|
1
|
7379
|
my ($tc) = @_; |
|
699
|
|
|
|
|
|
|
|
|
700
|
15
|
|
|
|
|
43
|
$tc->{set} = { }; |
|
701
|
15
|
|
|
|
|
34
|
$tc->{label} = { }; |
|
702
|
15
|
|
|
|
|
30
|
$tc->{count} = { }; |
|
703
|
15
|
|
|
|
|
42
|
$tc->{tested} = { }; |
|
704
|
|
|
|
|
|
|
} |
|
705
|
|
|
|
|
|
|
|
|
706
|
|
|
|
|
|
|
|
|
707
|
|
|
|
|
|
|
# reset_condition ( ) |
|
708
|
|
|
|
|
|
|
# |
|
709
|
|
|
|
|
|
|
# Reset the status of the specified condition. |
|
710
|
|
|
|
|
|
|
|
|
711
|
|
|
|
|
|
|
sub reset_condition { |
|
712
|
|
|
|
|
|
|
|
|
713
|
1
|
|
|
1
|
1
|
1821
|
my ($tc, $key) = @_; |
|
714
|
|
|
|
|
|
|
|
|
715
|
1
|
50
|
33
|
|
|
7
|
croak "you must specify a non-empty key" unless defined $key && $key ne ''; |
|
716
|
|
|
|
|
|
|
|
|
717
|
1
|
|
|
|
|
2
|
delete $tc->{set}{$key}; |
|
718
|
1
|
|
|
|
|
1
|
delete $tc->{label}{$key}; |
|
719
|
1
|
|
|
|
|
2
|
delete $tc->{count}{$key}; |
|
720
|
1
|
|
|
|
|
1
|
delete $tc->{tested}{$key}; |
|
721
|
|
|
|
|
|
|
} |
|
722
|
|
|
|
|
|
|
|
|
723
|
|
|
|
|
|
|
|
|
724
|
|
|
|
|
|
|
# reset_limits ( ) |
|
725
|
|
|
|
|
|
|
# |
|
726
|
|
|
|
|
|
|
# Remove all limits that were set. |
|
727
|
|
|
|
|
|
|
|
|
728
|
|
|
|
|
|
|
sub reset_limits { |
|
729
|
|
|
|
|
|
|
|
|
730
|
0
|
|
|
0
|
0
|
|
my ($tc) = @_; |
|
731
|
|
|
|
|
|
|
|
|
732
|
0
|
|
|
|
|
|
$tc->{max} = { }; |
|
733
|
|
|
|
|
|
|
} |
|
734
|
|
|
|
|
|
|
|
|
735
|
|
|
|
|
|
|
|
|
736
|
|
|
|
|
|
|
# reset_expects ( ) |
|
737
|
|
|
|
|
|
|
# |
|
738
|
|
|
|
|
|
|
# Remove all expects that were set. |
|
739
|
|
|
|
|
|
|
|
|
740
|
|
|
|
|
|
|
sub reset_expects { |
|
741
|
|
|
|
|
|
|
|
|
742
|
0
|
|
|
0
|
0
|
|
my ($tc) = @_; |
|
743
|
|
|
|
|
|
|
|
|
744
|
0
|
|
|
|
|
|
$tc->{expect} = { }; |
|
745
|
|
|
|
|
|
|
} |
|
746
|
|
|
|
|
|
|
|
|
747
|
|
|
|
|
|
|
|
|
748
|
|
|
|
|
|
|
=head1 NAME |
|
749
|
|
|
|
|
|
|
|
|
750
|
|
|
|
|
|
|
Test::Conditions - test multiple conditions across a large data structure or list in a simple and compact way |
|
751
|
|
|
|
|
|
|
|
|
752
|
|
|
|
|
|
|
=head1 VERSION |
|
753
|
|
|
|
|
|
|
|
|
754
|
|
|
|
|
|
|
Version 0.8 |
|
755
|
|
|
|
|
|
|
|
|
756
|
|
|
|
|
|
|
=head1 SYNOPSIS |
|
757
|
|
|
|
|
|
|
|
|
758
|
|
|
|
|
|
|
$tc = Test::Conditions->new; |
|
759
|
|
|
|
|
|
|
|
|
760
|
|
|
|
|
|
|
foreach my $node ( @list ) |
|
761
|
|
|
|
|
|
|
{ |
|
762
|
|
|
|
|
|
|
$tc->flag('foo missing', $node->{name}) |
|
763
|
|
|
|
|
|
|
unless defined $node->{foo}; |
|
764
|
|
|
|
|
|
|
$tc->flag('bar missing', $node->{name}) |
|
765
|
|
|
|
|
|
|
unless defined $node->{bar} && $node->{bar} > 0; |
|
766
|
|
|
|
|
|
|
} |
|
767
|
|
|
|
|
|
|
|
|
768
|
|
|
|
|
|
|
$tc->ok_all("all nodes have proper attributes"); |
|
769
|
|
|
|
|
|
|
|
|
770
|
|
|
|
|
|
|
=head1 DESCRIPTION |
|
771
|
|
|
|
|
|
|
|
|
772
|
|
|
|
|
|
|
The purpose of this module is to facilitate testing complex data structures such as trees, lists |
|
773
|
|
|
|
|
|
|
of hashes, results of database queries, etc. You may want to run certain tests on each node or |
|
774
|
|
|
|
|
|
|
row, and report the results in a compact way. You might, for example, wish to test a list or |
|
775
|
|
|
|
|
|
|
other structure with 1,000 nodes and report the result as a single test rather than multiple |
|
776
|
|
|
|
|
|
|
thousands of individual tests. This module provides a far more flexible approach than the |
|
777
|
|
|
|
|
|
|
C method of L. |
|
778
|
|
|
|
|
|
|
|
|
779
|
|
|
|
|
|
|
An object of class Test::Conditions can keep track of any number of conditions, and reports a |
|
780
|
|
|
|
|
|
|
single event when its C method is called. Under the most common usage, the test fails if |
|
781
|
|
|
|
|
|
|
one or more conditions are flagged, and succeeds if none are. Each condition which has been flagged |
|
782
|
|
|
|
|
|
|
is reported as a separate diagnostic message. Futhermore, if the nodes or other pieces of the |
|
783
|
|
|
|
|
|
|
data structure have unique identifiers, you can easily arrange for Test::Conditions to report the |
|
784
|
|
|
|
|
|
|
identifier of one of the failing nodes to help you in diagnosing the problem. |
|
785
|
|
|
|
|
|
|
|
|
786
|
|
|
|
|
|
|
=head2 Conditions |
|
787
|
|
|
|
|
|
|
|
|
788
|
|
|
|
|
|
|
Each separate condition that you wish to test is indicated by a key. This can be any non-empty |
|
789
|
|
|
|
|
|
|
string that is not a number. You can L"set"> or L"clear"> any condition, and you can specify |
|
790
|
|
|
|
|
|
|
whether or not this condition is expected to be set. After many set and/or clear operations, you |
|
791
|
|
|
|
|
|
|
can execute a single test using L"ok_all"> that will pass and fail depending on whether any |
|
792
|
|
|
|
|
|
|
conditions are set. |
|
793
|
|
|
|
|
|
|
|
|
794
|
|
|
|
|
|
|
=head3 Labels |
|
795
|
|
|
|
|
|
|
|
|
796
|
|
|
|
|
|
|
Instead of just setting a condition, you can L"flag"> it. This involves specifying some string (a |
|
797
|
|
|
|
|
|
|
label) to indicate where in the data that you are testing this condition occurs. This could |
|
798
|
|
|
|
|
|
|
represent a database key, or a node name or address, or anything else that will indicate useful |
|
799
|
|
|
|
|
|
|
information about where the condition occurred. A condition can be flagged multiple times, and |
|
800
|
|
|
|
|
|
|
will be reported only once. The first non-empty label that was flagged will be reported as well. |
|
801
|
|
|
|
|
|
|
|
|
802
|
|
|
|
|
|
|
=head3 Positive and negative conditions |
|
803
|
|
|
|
|
|
|
|
|
804
|
|
|
|
|
|
|
A condition can be a positive or a negative one, depending on whether it is expected or not. If |
|
805
|
|
|
|
|
|
|
you specify that a particular condition is expected, then L"ok_all"> will pass if that condition |
|
806
|
|
|
|
|
|
|
has been set and fail if not. If a condition is not expected, then the situation is reversed. |
|
807
|
|
|
|
|
|
|
|
|
808
|
|
|
|
|
|
|
=head1 METHODS |
|
809
|
|
|
|
|
|
|
|
|
810
|
|
|
|
|
|
|
=head3 new |
|
811
|
|
|
|
|
|
|
|
|
812
|
|
|
|
|
|
|
This class method creates a new Test::Conditions instance. This instance can then be used to |
|
813
|
|
|
|
|
|
|
record whether some set of conditions has been set or cleared, and to execute a single test |
|
814
|
|
|
|
|
|
|
encapsulating this result. |
|
815
|
|
|
|
|
|
|
|
|
816
|
|
|
|
|
|
|
=head2 Setting and clearing of conditions |
|
817
|
|
|
|
|
|
|
|
|
818
|
|
|
|
|
|
|
=head3 set ( key ) |
|
819
|
|
|
|
|
|
|
|
|
820
|
|
|
|
|
|
|
Sets the specified condition. The single argument must be a scalar whose |
|
821
|
|
|
|
|
|
|
value is the name (key) of the condition to be set. |
|
822
|
|
|
|
|
|
|
|
|
823
|
|
|
|
|
|
|
=head3 clear ( key ) |
|
824
|
|
|
|
|
|
|
|
|
825
|
|
|
|
|
|
|
Clears the specified condition. The single argument must be a scalar whose |
|
826
|
|
|
|
|
|
|
value is the name (key) of the condition to be cleared. |
|
827
|
|
|
|
|
|
|
|
|
828
|
|
|
|
|
|
|
=head3 flag ( key, [ label ] ) |
|
829
|
|
|
|
|
|
|
|
|
830
|
|
|
|
|
|
|
Sets the specified condition, and can also record an arbitrary label. This label can be any |
|
831
|
|
|
|
|
|
|
non-empty string, but it is best to use some key value or node field that will indicate where in |
|
832
|
|
|
|
|
|
|
the set of data being tested the condition occurred. The first non-empty label to be flagged for |
|
833
|
|
|
|
|
|
|
any particular condition will be reported when a test fails due to that condition, so that you can |
|
834
|
|
|
|
|
|
|
use that information for debugging purposes. The number of times each condition is flagged is also |
|
835
|
|
|
|
|
|
|
recorded, and minimum and maximum limits can also be specified. See L"limit_max"> and |
|
836
|
|
|
|
|
|
|
L"expect_min"> below. |
|
837
|
|
|
|
|
|
|
|
|
838
|
|
|
|
|
|
|
In general, you will want to use either 'set' or 'flag' with any particular condition, and not |
|
839
|
|
|
|
|
|
|
both. It is generally best to use 'set' for conditions that reflect a problem with the data |
|
840
|
|
|
|
|
|
|
structure as a whole, and 'flag' for conditions that are specific to a particular piece of it. |
|
841
|
|
|
|
|
|
|
|
|
842
|
|
|
|
|
|
|
=head3 decrement ( condition, [ label ] ) |
|
843
|
|
|
|
|
|
|
|
|
844
|
|
|
|
|
|
|
This method decrements the count of how many times the specified condition has been flagged. If a |
|
845
|
|
|
|
|
|
|
label is specified, and if that label matches the label stored for this condition, it is |
|
846
|
|
|
|
|
|
|
cleared. Basically, if this method is called immediately after L"flag"> and with the same |
|
847
|
|
|
|
|
|
|
arguments, the effect of the flag will be undone. This method only exists so that if 'flag' has |
|
848
|
|
|
|
|
|
|
been called in error the effect can be reversed. |
|
849
|
|
|
|
|
|
|
|
|
850
|
|
|
|
|
|
|
If a call to this method results in the count reaching zero, the condition is cleared. |
|
851
|
|
|
|
|
|
|
|
|
852
|
|
|
|
|
|
|
=head3 expect ( condition... ) |
|
853
|
|
|
|
|
|
|
|
|
854
|
|
|
|
|
|
|
This method marks one or more conditions as B. Subsequently, L"ok_all"> will fail unless |
|
855
|
|
|
|
|
|
|
all of the expected conditions are set. This is how you specify positive conditions instead of negative |
|
856
|
|
|
|
|
|
|
ones. For example: |
|
857
|
|
|
|
|
|
|
|
|
858
|
|
|
|
|
|
|
$tc = Test::Conditions->new; |
|
859
|
|
|
|
|
|
|
|
|
860
|
|
|
|
|
|
|
$tc->expect('found aaa', 'found bbb'); |
|
861
|
|
|
|
|
|
|
|
|
862
|
|
|
|
|
|
|
foreach my $node ( @list ) |
|
863
|
|
|
|
|
|
|
{ |
|
864
|
|
|
|
|
|
|
$tc->flag('found aaa', $node->{name}) if $node->{key} eq 'aaa'; |
|
865
|
|
|
|
|
|
|
$tc->flag('found bbb', $node->{name}) if $node->{key} eq 'bbb'; |
|
866
|
|
|
|
|
|
|
} |
|
867
|
|
|
|
|
|
|
|
|
868
|
|
|
|
|
|
|
$tc->ok_all("found both keys"); |
|
869
|
|
|
|
|
|
|
|
|
870
|
|
|
|
|
|
|
if ( $tc->is_set('found aaa') ) |
|
871
|
|
|
|
|
|
|
{ |
|
872
|
|
|
|
|
|
|
my $node_name = $tc->get_label('found aaa'); |
|
873
|
|
|
|
|
|
|
diag(" Found key 'aaa' at node '$node_name'"); |
|
874
|
|
|
|
|
|
|
} |
|
875
|
|
|
|
|
|
|
|
|
876
|
|
|
|
|
|
|
You can use both positive (expected) and negative (non-expected) conditions together. A call to |
|
877
|
|
|
|
|
|
|
L"ok_all"> will succeed precisely when all of the expected conditions have been set and no |
|
878
|
|
|
|
|
|
|
non-expected conditions have. |
|
879
|
|
|
|
|
|
|
|
|
880
|
|
|
|
|
|
|
=head3 expect_min ( condition, n ) |
|
881
|
|
|
|
|
|
|
|
|
882
|
|
|
|
|
|
|
This method indicates that the specified condition is expected to be flagged at least I |
|
883
|
|
|
|
|
|
|
times. If it is flagged fewer times than that, or not at all, then L"ok_all"> will fail. Calling |
|
884
|
|
|
|
|
|
|
this method with a count of 1 is exactly the same as calling L"expect"> on the same condition. |
|
885
|
|
|
|
|
|
|
|
|
886
|
|
|
|
|
|
|
=head3 limit_max ( condition, n ) |
|
887
|
|
|
|
|
|
|
|
|
888
|
|
|
|
|
|
|
This method indicates that the specified condition should be flagged at most I times. If it is |
|
889
|
|
|
|
|
|
|
flagged more times than that, then L"ok_all"> will fail. You can use this, for example, if you |
|
890
|
|
|
|
|
|
|
expect a few nodes in your data structure to be missing particular fields but you want the test to fail |
|
891
|
|
|
|
|
|
|
if more than a certain number are. |
|
892
|
|
|
|
|
|
|
|
|
893
|
|
|
|
|
|
|
=head2 Testing |
|
894
|
|
|
|
|
|
|
|
|
895
|
|
|
|
|
|
|
=head3 ok_all ( test_name ) |
|
896
|
|
|
|
|
|
|
|
|
897
|
|
|
|
|
|
|
This method will execute a single test, with the specified string as the test name. The test |
|
898
|
|
|
|
|
|
|
will pass if all expected (positive) conditions are set, and if no non-expected (negative) |
|
899
|
|
|
|
|
|
|
conditions are set. |
|
900
|
|
|
|
|
|
|
|
|
901
|
|
|
|
|
|
|
If a negative condition was flagged rather than set, then a diagnostic message will be printed |
|
902
|
|
|
|
|
|
|
indicating the label with which it was first flagged, and the total number of times it was |
|
903
|
|
|
|
|
|
|
flagged. If you set these labels based on keys or node names or other indications of where in the |
|
904
|
|
|
|
|
|
|
data structure is being tested, this can help you to figure out what is going wrong. |
|
905
|
|
|
|
|
|
|
|
|
906
|
|
|
|
|
|
|
If a minimum and/or maximum limit has been set on a particular condition, then the test will |
|
907
|
|
|
|
|
|
|
pass only if the number of times the condition was flagged does not fall outside of these limits. |
|
908
|
|
|
|
|
|
|
|
|
909
|
|
|
|
|
|
|
All conditions that are tested by this method are marked as being tested. Subsequent calls to |
|
910
|
|
|
|
|
|
|
'ok_all' or 'ok_condition' will ignore them, unless they have been explicitly set or cleared |
|
911
|
|
|
|
|
|
|
afterward. However, methods such as 'is_set', 'get_count', etc. will still work on it. |
|
912
|
|
|
|
|
|
|
|
|
913
|
|
|
|
|
|
|
=head3 ok_condition ( condition, test_name ) |
|
914
|
|
|
|
|
|
|
|
|
915
|
|
|
|
|
|
|
This method will test a single condition, and will pass or fail the specified test name. If the |
|
916
|
|
|
|
|
|
|
condition is expected, then it will pass only if set. If it is not expected, then it will pass |
|
917
|
|
|
|
|
|
|
only if not set. |
|
918
|
|
|
|
|
|
|
|
|
919
|
|
|
|
|
|
|
If a minimum and/or maximum limit has been set on this condition, then the test will pass only if |
|
920
|
|
|
|
|
|
|
the number of times the condition was flagged does not fall outside of these limits. |
|
921
|
|
|
|
|
|
|
|
|
922
|
|
|
|
|
|
|
The condition that is tested by this method is marked as being tested. Subsequent calls to |
|
923
|
|
|
|
|
|
|
'ok_all' or 'ok_condition' will ignore it, unless it has0 been explicitly set or cleared |
|
924
|
|
|
|
|
|
|
afterward. However, methods such as 'is_set', 'get_count', etc. will still work on it. |
|
925
|
|
|
|
|
|
|
|
|
926
|
|
|
|
|
|
|
=head2 Accessors |
|
927
|
|
|
|
|
|
|
|
|
928
|
|
|
|
|
|
|
The following methods can be used to check the status of any condition |
|
929
|
|
|
|
|
|
|
|
|
930
|
|
|
|
|
|
|
=head3 is_set ( condition ) |
|
931
|
|
|
|
|
|
|
|
|
932
|
|
|
|
|
|
|
Returns 1 if the condition is set, 0 if it has been explicitly cleared, and I if it has |
|
933
|
|
|
|
|
|
|
been neither set nor cleared. |
|
934
|
|
|
|
|
|
|
|
|
935
|
|
|
|
|
|
|
=head3 is_tested ( condition ) |
|
936
|
|
|
|
|
|
|
|
|
937
|
|
|
|
|
|
|
Returns 1 if L"ok_all"> or L"ok_condition"> has been called on this condition, and it has not |
|
938
|
|
|
|
|
|
|
been set or cleared since. |
|
939
|
|
|
|
|
|
|
|
|
940
|
|
|
|
|
|
|
=head3 get_count ( condition ) |
|
941
|
|
|
|
|
|
|
|
|
942
|
|
|
|
|
|
|
Returns the number of times the condition has been flagged, or I if it has never been |
|
943
|
|
|
|
|
|
|
flagged. |
|
944
|
|
|
|
|
|
|
|
|
945
|
|
|
|
|
|
|
=head3 get_label ( condition ) |
|
946
|
|
|
|
|
|
|
|
|
947
|
|
|
|
|
|
|
Returns the label stored for this condition, or I if it has never been flagged with a |
|
948
|
|
|
|
|
|
|
non-empty label. |
|
949
|
|
|
|
|
|
|
|
|
950
|
|
|
|
|
|
|
=head3 active_conditions ( ) |
|
951
|
|
|
|
|
|
|
|
|
952
|
|
|
|
|
|
|
Returns a list of all conditions that are currently set but have not yet been tested. |
|
953
|
|
|
|
|
|
|
|
|
954
|
|
|
|
|
|
|
=head3 expected_conditions ( ) |
|
955
|
|
|
|
|
|
|
|
|
956
|
|
|
|
|
|
|
Returns a list of all conditions that are currently expected. |
|
957
|
|
|
|
|
|
|
|
|
958
|
|
|
|
|
|
|
=head3 all_conditions ( ) |
|
959
|
|
|
|
|
|
|
|
|
960
|
|
|
|
|
|
|
Returns a list of all conditions that have been set or cleared, regardless of whether or not they |
|
961
|
|
|
|
|
|
|
have been tested. |
|
962
|
|
|
|
|
|
|
|
|
963
|
|
|
|
|
|
|
=head2 Resetting |
|
964
|
|
|
|
|
|
|
|
|
965
|
|
|
|
|
|
|
If you have set up expected conditions and/or limits, you may wish to run the same |
|
966
|
|
|
|
|
|
|
Test::Conditions instance on more than one data structure. Once you have run L"ok_all"> on a |
|
967
|
|
|
|
|
|
|
given instance, all of the active conditions are marked as "tested" and will be ignored from then |
|
968
|
|
|
|
|
|
|
on unless subsequently set or cleared. So you can go ahead and use the same instance to test |
|
969
|
|
|
|
|
|
|
multiple bodies of data and the results will be correct. It is okay to call 'ok_all' or |
|
970
|
|
|
|
|
|
|
'ok_condition' as many times as needed. At each call, only the status of those conditions that |
|
971
|
|
|
|
|
|
|
have been explicitly set or cleared since the last call will be considered. |
|
972
|
|
|
|
|
|
|
|
|
973
|
|
|
|
|
|
|
If you wish to reset some or all conditions without calling 'ok_all' or 'ok_condition', you can use the |
|
974
|
|
|
|
|
|
|
following methods: |
|
975
|
|
|
|
|
|
|
|
|
976
|
|
|
|
|
|
|
=head3 reset_conditions ( ) |
|
977
|
|
|
|
|
|
|
|
|
978
|
|
|
|
|
|
|
This method resets the status of all conditions, as if they had never been set or cleared. Limits |
|
979
|
|
|
|
|
|
|
and expects are preserved. |
|
980
|
|
|
|
|
|
|
|
|
981
|
|
|
|
|
|
|
=head3 reset_condition ( condition ) |
|
982
|
|
|
|
|
|
|
|
|
983
|
|
|
|
|
|
|
This method resets the status of a single condition. |
|
984
|
|
|
|
|
|
|
|
|
985
|
|
|
|
|
|
|
=head1 AUTHOR |
|
986
|
|
|
|
|
|
|
|
|
987
|
|
|
|
|
|
|
Michael McClennen |
|
988
|
|
|
|
|
|
|
|
|
989
|
|
|
|
|
|
|
=head1 BUGS |
|
990
|
|
|
|
|
|
|
|
|
991
|
|
|
|
|
|
|
Please report any bugs or feature requests to C, or through |
|
992
|
|
|
|
|
|
|
the web interface at L. I will be notified, and then you'll |
|
993
|
|
|
|
|
|
|
automatically be notified of progress on your bug as I make changes. |
|
994
|
|
|
|
|
|
|
|
|
995
|
|
|
|
|
|
|
=head1 LICENSE AND COPYRIGHT |
|
996
|
|
|
|
|
|
|
|
|
997
|
|
|
|
|
|
|
Copyright 2018 Michael McClennen. |
|
998
|
|
|
|
|
|
|
|
|
999
|
|
|
|
|
|
|
This program is free software; you can redistribute it and/or modify it |
|
1000
|
|
|
|
|
|
|
under the terms of the the Artistic License (2.0). You may obtain a |
|
1001
|
|
|
|
|
|
|
copy of the full license at: |
|
1002
|
|
|
|
|
|
|
|
|
1003
|
|
|
|
|
|
|
L |
|
1004
|
|
|
|
|
|
|
|
|
1005
|
|
|
|
|
|
|
Any use, modification, and distribution of the Standard or Modified |
|
1006
|
|
|
|
|
|
|
Versions is governed by this Artistic License. By using, modifying or |
|
1007
|
|
|
|
|
|
|
distributing the Package, you accept this license. Do not use, modify, |
|
1008
|
|
|
|
|
|
|
or distribute the Package, if you do not accept this license. |
|
1009
|
|
|
|
|
|
|
|
|
1010
|
|
|
|
|
|
|
If your Modified Version has been derived from a Modified Version made |
|
1011
|
|
|
|
|
|
|
by someone other than you, you are nevertheless required to ensure that |
|
1012
|
|
|
|
|
|
|
your Modified Version complies with the requirements of this license. |
|
1013
|
|
|
|
|
|
|
|
|
1014
|
|
|
|
|
|
|
This license does not grant you the right to use any trademark, service |
|
1015
|
|
|
|
|
|
|
mark, tradename, or logo of the Copyright Holder. |
|
1016
|
|
|
|
|
|
|
|
|
1017
|
|
|
|
|
|
|
This license includes the non-exclusive, worldwide, free-of-charge |
|
1018
|
|
|
|
|
|
|
patent license to make, have made, use, offer to sell, sell, import and |
|
1019
|
|
|
|
|
|
|
otherwise transfer the Package with respect to any patent claims |
|
1020
|
|
|
|
|
|
|
licensable by the Copyright Holder that are necessarily infringed by the |
|
1021
|
|
|
|
|
|
|
Package. If you institute patent litigation (including a cross-claim or |
|
1022
|
|
|
|
|
|
|
counterclaim) against any party alleging that the Package constitutes |
|
1023
|
|
|
|
|
|
|
direct or contributory patent infringement, then this Artistic License |
|
1024
|
|
|
|
|
|
|
to you shall terminate on the date that such litigation is filed. |
|
1025
|
|
|
|
|
|
|
|
|
1026
|
|
|
|
|
|
|
Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER |
|
1027
|
|
|
|
|
|
|
AND CONTRIBUTORS "AS IS' AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES. |
|
1028
|
|
|
|
|
|
|
THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR |
|
1029
|
|
|
|
|
|
|
PURPOSE, OR NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY |
|
1030
|
|
|
|
|
|
|
YOUR LOCAL LAW. UNLESS REQUIRED BY LAW, NO COPYRIGHT HOLDER OR |
|
1031
|
|
|
|
|
|
|
CONTRIBUTOR WILL BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, OR |
|
1032
|
|
|
|
|
|
|
CONSEQUENTIAL DAMAGES ARISING IN ANY WAY OUT OF THE USE OF THE PACKAGE, |
|
1033
|
|
|
|
|
|
|
EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. |
|
1034
|
|
|
|
|
|
|
|
|
1035
|
|
|
|
|
|
|
=cut |
|
1036
|
|
|
|
|
|
|
|
|
1037
|
|
|
|
|
|
|
1; |