File Coverage

lib/Test/Conditions.pm
Criterion Covered Total %
statement 180 202 89.1
branch 95 138 68.8
condition 69 125 55.2
subroutine 26 28 92.8
pod 19 23 82.6
total 389 516 75.3


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 or L 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 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 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 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 and
836             L 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 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 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 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 will fail. Calling
884             this method with a count of 1 is exactly the same as calling L 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 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 or L 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 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;