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