File Coverage

blib/lib/Test/Data/Array.pm
Criterion Covered Total %
statement 95 114 83.3
branch 26 38 68.4
condition 16 33 48.4
subroutine 17 20 85.0
pod 15 15 100.0
total 169 220 76.8


line stmt bran cond sub pod time code
1 3     3   1778 use 5.008;
  3         10  
2              
3             package Test::Data::Array;
4 3     3   15 use strict;
  3         7  
  3         65  
5              
6 3     3   12 use Exporter qw(import);
  3         5  
  3         226  
7             our $VERSION = '1.244';
8              
9             our @EXPORT = qw( array_any_ok array_none_ok array_once_ok array_multiple_ok
10             array_max_ok array_min_ok array_maxstr_ok array_minstr_ok array_sum_ok
11             array_length_ok array_empty_ok
12             array_sortedstr_ascending_ok array_sortedstr_descending_ok
13             array_sorted_ascending_ok array_sorted_descending_ok
14             );
15              
16 3     3   20 use List::Util qw(sum min max minstr maxstr);
  3         4  
  3         331  
17              
18 3     3   35 use Test::Builder;
  3         5  
  3         3376  
19             my $Test = Test::Builder->new();
20              
21             =encoding utf8
22              
23             =head1 NAME
24              
25             Test::Data::Array -- test functions for array variables
26              
27             =head1 SYNOPSIS
28              
29             use Test::Data qw(Array);
30              
31             =head1 DESCRIPTION
32              
33             =head2 Functions
34              
35             =over 4
36              
37             =item array_any_ok( ITEM, ARRAY [, NAME] )
38              
39             Ok if any element of ARRAY is ITEM.
40              
41             =cut
42              
43             sub array_any_ok($\@;$) {
44 2     2 1 1512 my $element = shift;
45 2         5 my $array = shift;
46 2   100     20 my $name = shift || 'Array contains item';
47              
48 2         4 foreach my $try ( @$array ) {
49 5 100       12 next unless $try eq $element;
50 1         8 $Test->ok( 1, $name );
51 1         288 return;
52             }
53              
54 1         4 $Test->ok( 0, $name );
55             }
56              
57             =item array_none_ok( ITEM, ARRAY [, NAME] )
58              
59             Ok if no element of ARRAY is ITEM.
60              
61             =cut
62              
63             sub array_none_ok($\@;$) {
64 1     1 1 821 my $element = shift;
65 1         2 my $array = shift;
66 1   50     6 my $name = shift || 'Array does not contain item';
67              
68 1         4 foreach my $try ( @$array ) {
69 3 50       8 next unless $try eq $element;
70 0         0 $Test->ok( 0, $name );
71 0         0 return;
72             }
73              
74 1         4 $Test->ok( 1, $name );
75             }
76              
77             =item array_once_ok( ITEM, ARRAY [, NAME] )
78              
79             Ok if only one element of ARRAY is ITEM.
80              
81             =cut
82              
83             sub array_once_ok($\@;$) {
84 4     4 1 2884 my $element = shift;
85 4         6 my $array = shift;
86 4   50     11 my $name = shift || 'Array contains item only once';
87              
88 4         5 my %seen = ();
89              
90 4         6 my $ok = 0;
91 4         7 foreach my $item ( @$array ) { ++$seen{$item} }
  7         15  
92              
93 4 100 100     16 $ok = 1 if( defined $seen{$element} and $seen{$element} == 1 );
94              
95 4         11 $Test->ok( $ok, $name );
96             }
97              
98             =item array_multiple_ok( ITEM, ARRAY [, NAME] )
99              
100             Ok if more than one element of ARRAY is ITEM.
101              
102             =cut
103              
104             sub array_multiple_ok($\@;$) {
105 0     0 1 0 my $element = shift;
106 0         0 my $array = shift;
107 0   0     0 my $name = shift || 'Array contains item at least once';
108              
109 0         0 my %seen = ();
110 0         0 foreach my $item ( @$array )
111             {
112 0         0 $seen{$item}++;
113             }
114              
115 0 0       0 $seen{$element} > 1 ? $Test->ok( 1, $name ) : $Test->ok( 0, $name );
116             }
117              
118             =item array_max_ok( NUMBER, ARRAY [, NAME] )
119              
120             Ok if all elements of ARRAY are numerically less than
121             or equal to NUMBER.
122              
123             =cut
124              
125             sub array_max_ok($\@;$) {
126 1     1 1 218 my $item = shift;
127 1         3 my $array = shift;
128 1   50     6 my $name = shift || 'Array maximum is okay';
129              
130 1         5 my $actual = max( @$array );
131              
132 1 50       7 $actual <= $item ? $Test->ok( 1, $name ) : $Test->ok( 0, $name );
133             }
134              
135             =item array_min_ok( NUMBER, ARRAY [, NAME] )
136              
137             Ok if all elements of ARRAY are numerically greater than
138             or equal to NUMBER.
139              
140             =cut
141              
142             sub array_min_ok($\@;$) {
143 1     1 1 244 my $item = shift;
144 1         2 my $array = shift;
145 1   50     5 my $name = shift || 'Array minimum is okay';
146              
147 1         4 my $actual = min( @$array );
148              
149 1 50       5 $actual >= $item ? $Test->ok( 1, $name ) : $Test->ok( 0, $name );
150             }
151              
152             =item array_maxstr_ok( ITEM, ARRAY [, NAME] )
153              
154             Ok if all elements of ARRAY are asciibetically less than
155             or equal to MAX.
156              
157             =cut
158              
159             sub array_maxstr_ok($\@;$) {
160 0     0 1 0 my $item = shift;
161 0         0 my $array = shift;
162 0   0     0 my $name = shift || 'Array maximum string is okay';
163              
164 0         0 my $actual = maxstr( @$array );
165              
166 0 0       0 $actual ge $item ? $Test->ok( 1, $name ) : $Test->ok( 0, $name );
167             }
168              
169             =item array_minstr_ok( ITEM, ARRAY [, NAME] )
170              
171             Ok if all elements of ARRAY are asciibetically greater than
172             or equal to MAX.
173              
174             =cut
175              
176             sub array_minstr_ok($\@;$) {
177 0     0 1 0 my $item = shift;
178 0         0 my $array = shift;
179 0   0     0 my $name = shift || 'Array minimum string is okay';
180              
181 0         0 my $actual = minstr( @$array );
182              
183 0 0       0 $actual le $item ? $Test->ok( 1, $name ) : $Test->ok( 0, $name );
184             }
185              
186             =item array_sum_ok( SUM, ARRAY [, NAME] )
187              
188             Ok if the numerical sum of ARRAY is SUM.
189              
190             =cut
191              
192             sub array_sum_ok($\@;$) {
193 1     1 1 233 my $sum = shift;
194 1         1 my $array = shift;
195 1   50     8 my $name = shift || 'Array sum is correct';
196              
197 1         6 my $actual = sum( @$array );
198              
199 1 50       6 $sum == $actual ? $Test->ok( 1, $name ) : $Test->ok( 0, $name );
200             }
201              
202             =item array_empty_ok( ARRAY [, NAME] )
203              
204             Ok if the array contains no elements.
205              
206             =cut
207              
208             sub array_empty_ok(\@;$) {
209 1     1 1 215 my $array = shift;
210 1   50     5 my $name = shift || 'Array is empty';
211              
212 1 50       6 $#$array == -1 ? $Test->ok( 1, $name ) : $Test->ok( 0, $name );
213             }
214              
215              
216             =item array_length_ok( ARRAY, LENGTH [, NAME] )
217              
218             Ok if the array contains LENGTH number of elements.
219              
220             =cut
221              
222             sub array_length_ok(\@$;$) {
223 1     1 1 189 my $array = shift;
224 1         2 my $length = shift;
225 1   50     7 my $name = shift || 'Array length is correct';
226              
227 1 50       6 $#$array == $length - 1 ? $Test->ok( 1, $name ) : $Test->ok( 0, $name );
228             }
229              
230             =item array_sortedstr_ascending_ok( ARRAY, [, NAME] )
231              
232             Ok if each succeeding element is asciibetically greater than or equal
233             to the one before.
234              
235             =cut
236              
237             sub array_sortedstr_ascending_ok(\@;$) {
238 3     3 1 3908 my $array = shift;
239 3   50     15 my $name = shift || 'Array is in ascending order';
240              
241 3         7 my $last_seen = 0;
242              
243 3         10 ELEMENT: foreach my $index ( 1 .. $#$array ) {
244 12 100       25 if( $array->[ $index ] ge $array->[ $index - 1 ] ) {
245 10         12 $last_seen = $index;
246 10         13 next;
247             }
248 2         3 last;
249             }
250              
251 3 100       15 $last_seen == $#$array ?
252             $Test->ok( 1, $name )
253             :
254             $Test->ok( 0, $name );
255             }
256              
257             =item array_sortedstr_descending_ok( ARRAY, [, NAME] )
258              
259             Ok if each succeeding element is asciibetically less than or equal to
260             the one before.
261              
262             =cut
263              
264             sub array_sortedstr_descending_ok(\@;$) {
265 3     3 1 1927 my $array = shift;
266 3   50     13 my $name = shift || 'Array is in descending order';
267              
268 3         6 my $last_seen = 0;
269              
270 3         7 ELEMENT: foreach my $index ( 1 .. $#$array ) {
271 7 100       16 if( $array->[ $index ] le $array->[ $index - 1 ] )
272             {
273 5         7 $last_seen = $index;
274 5         6 next;
275             }
276 2         5 last;
277             }
278              
279 3 100       13 $last_seen == $#$array ?
280             $Test->ok( 1, $name )
281             :
282             $Test->ok( 0, $name );
283             }
284              
285             =item array_sorted_ascending_ok( ARRAY, [, NAME] )
286              
287             Ok if each succeeding element is numerically greater than or equal
288             to the one before.
289              
290             =cut
291              
292             sub array_sorted_ascending_ok(\@;$) {
293 3     3 1 4572 my $array = shift;
294 3   50     15 my $name = shift || 'Array is in ascending order';
295              
296 3         4 my $last_seen = 0;
297              
298 3         9 ELEMENT: foreach my $index ( 1 .. $#$array ) {
299 10 100       24 if( $array->[ $index ] >= $array->[ $index - 1 ] ) {
300 8         11 $last_seen = $index;
301 8         11 next;
302             }
303 2         3 last;
304             }
305              
306 3 100       15 $last_seen == $#$array ?
307             $Test->ok( 1, $name )
308             :
309             $Test->ok( 0, $name );
310             }
311              
312             =item array_sorted_descending_ok( ARRAY, [, NAME] )
313              
314             Ok if each succeeding element is numerically less than or equal to
315             the one before.
316              
317             =cut
318              
319             sub array_sorted_descending_ok(\@;$) {
320 3     3 1 1902 my $array = shift;
321 3   50     11 my $name = shift || 'Array is in descending order';
322              
323 3         5 my $last_seen = 0;
324              
325 3         8 ELEMENT: foreach my $index ( 1 .. $#$array ) {
326 6 100       15 if( $array->[ $index ] <= $array->[ $index - 1 ] ) {
327 4         6 $last_seen = $index;
328 4         7 next;
329             }
330 2         3 last;
331             }
332              
333 3 100       26 $last_seen == $#$array ?
334             $Test->ok( 1, $name )
335             :
336             $Test->ok( 0, $name );
337             }
338              
339             =back
340              
341             =head1 SEE ALSO
342              
343             L,
344             L,
345             L,
346             L,
347             L
348              
349             =head1 SOURCE AVAILABILITY
350              
351             This source is in Github:
352              
353             https://github.com/briandfoy/test-data
354              
355             =head1 AUTHOR
356              
357             brian d foy, C<< >>
358              
359             =head1 COPYRIGHT AND LICENSE
360              
361             Copyright © 2002-2022, brian d foy . All rights reserved.
362              
363             This program is free software; you can redistribute it and/or modify
364             it under the terms of the Artistic License 2.0.
365              
366             =cut
367              
368             "bumble bee";