-
Notifications
You must be signed in to change notification settings - Fork 42
/
pick.t
119 lines (94 loc) · 2.6 KB
/
pick.t
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
#!/usr/bin/perl
use lib 't/lib';
use perl5i::latest;
use Test::More;
use Test::perl5i;
func pick_ok($array, $num) {
local $Test::Builder::Level = $Test::Builder::Level +1;
my @rand = $array->pick($num);
if($num <= @$array){
is @rand, $num;
}
else{
is @rand, @$array;
}
ok (is_subset($array, \@rand)) or diag sprintf <<END, explain $array, explain \@rand;
set: %s
subset: %s
END
}
func is_subset($array, $sub){
my %arr_hash;
for my $val (@$array){
$val = safe_key($val);
$arr_hash{$val}++;
}
for my $val (@$sub){
$val = safe_key($val);
$arr_hash{$val}--;
return 0 if $arr_hash{$val} < 0;
}
return 1;
}
func pick_one_ok($array){
local $Test::Builder::Level = $Test::Builder::Level +1;
my $elem = @$array->pick_one;
ok grep safe_key($_) eq safe_key($elem), @$array;
}
func safe_key($val){
return defined $val ? $val : "__UNDEFINED__";
}
note 'is_subset';{
ok !(is_subset([1,2,3,4] , [1,1,1]));
ok !(is_subset([1,1,1,1] , [1,2]));
ok is_subset([1,2,3,4] , [1,2]);
}
note 'pick()'; {
my @arr = qw(a b c d e f g h i);
pick_ok(\@arr, 5);
pick_ok(\@arr, 9);
pick_ok(\@arr, 100);
pick_ok(\@arr, 0);
}
note 'pick with undefined elements';{
pick_ok([undef,undef,undef] => 2);
}
note 'pick method with duplicate elements';{
pick_ok([1,1,2,2,3,3] => 6);
}
note "pick with no args"; {
my @array = (1, 2, 3);
throws_ok { @array->pick(); }
qr{^\Qpick() takes the number of elements to pick at $0 line };
}
note "pick with negative arg"; {
my @array = (1, 2, 3);
throws_ok { @array->pick(-20); }
qr{^\Qpick() takes a positive integer or zero, not '-20' at $0 line };
}
note "pick with non-numerical argument"; {
my @array = (1, 2, 3);
throws_ok { @array->pick("rawr"); }
qr{^\Qpick() takes a positive integer or zero, not 'rawr' at $0 line };
}
note "pick_one method";{
pick_one_ok([1,2,3,4,4]);
pick_one_ok(["a","b","c","d","e"]);
pick_one_ok([undef, undef, undef, undef]);
}
note "pick shuffles the result"; {
my $not_in_order = 0;
my @array = (1..10);
# Since @array is in ascending order, we should, eventually,
# get two picks where the first is larger than the second.
# There's a 50/50 chance for each pick, and with 1000 tries
# the odds of this failing are something like 1 in 1^300.
for(1..1000) {
my @picks = @array->pick(2);
next if $picks[0] < $picks[1];
$not_in_order = 1;
last;
}
ok $not_in_order;
}
done_testing;