|
Lines 6-14
Link Here
|
| 6 |
use strict; |
6 |
use strict; |
| 7 |
use warnings; |
7 |
use warnings; |
| 8 |
|
8 |
|
| 9 |
use Test::More tests => 1; |
9 |
use Data::Dumper; |
|
|
10 |
|
| 11 |
use Test::More tests => 30; |
| 10 |
|
12 |
|
| 11 |
BEGIN { |
13 |
BEGIN { |
| 12 |
use_ok('C4::Tags'); |
14 |
use_ok('C4::Tags'); |
| 13 |
} |
15 |
} |
| 14 |
|
16 |
|
| 15 |
- |
17 |
# Simple 'sequential 5' test |
|
|
18 |
my $tags = make_tags(1,2,3,4,5); |
| 19 |
my @strata = (0,1,2,3,4); |
| 20 |
my ($min, $max) = C4::Tags::stratify_tags(5, $tags); |
| 21 |
check_tag_strata($tags, \@strata, 'Sequential 5'); |
| 22 |
is($min, 0, 'Sequential 5 min'); |
| 23 |
is($max, 4, 'Sequential 5 max'); |
| 24 |
|
| 25 |
# Reverse test - should have the same results as previous |
| 26 |
$tags = make_tags(5,4,3,2,1); |
| 27 |
@strata = (4,3,2,1,0); |
| 28 |
($min, $max) = C4::Tags::stratify_tags(5, $tags); |
| 29 |
check_tag_strata($tags, \@strata, 'Reverse Sequential 5'); |
| 30 |
is($min, 0, 'Sequential 5 min'); |
| 31 |
is($max, 4, 'Sequential 5 max'); |
| 32 |
|
| 33 |
# All the same test - should all have the same results |
| 34 |
$tags = make_tags(4,4,4,4,4); |
| 35 |
@strata = (0,0,0,0,0); |
| 36 |
($min, $max) = C4::Tags::stratify_tags(5, $tags); |
| 37 |
check_tag_strata($tags, \@strata, 'All The Same'); |
| 38 |
is($min, 0, 'Sequential 5 min'); |
| 39 |
is($max, 0, 'Sequential 5 max'); |
| 40 |
|
| 41 |
# Some the same, some different |
| 42 |
$tags = make_tags(1,2,2,3,3,8); |
| 43 |
@strata = (0,0,0,1,1,4); |
| 44 |
($min, $max) = C4::Tags::stratify_tags(5, $tags); |
| 45 |
check_tag_strata($tags, \@strata, 'All The Same'); |
| 46 |
is($min, 0, 'Sequential 5 min'); |
| 47 |
is($max, 7, 'Sequential 5 max'); |
| 48 |
|
| 49 |
# Runs tests against the results |
| 50 |
sub check_tag_strata { |
| 51 |
my ($tags, $expected, $name) = @_; |
| 52 |
|
| 53 |
foreach my $t (@$tags) { |
| 54 |
my $w = $t->{weight_total}; |
| 55 |
my $s = $t->{stratum}; |
| 56 |
is($s, shift @$expected, $name . " - $w ($s)"); |
| 57 |
} |
| 58 |
} |
| 59 |
|
| 60 |
# Makes some tags with just enough info to test |
| 61 |
sub make_tags { |
| 62 |
my @res; |
| 63 |
while (@_) { |
| 64 |
push @res, { weight_total => shift @_ }; |
| 65 |
} |
| 66 |
return \@res; |
| 67 |
} |