1#!/usr/bin/env perl
2use strict;
3use warnings;
4
5use Test::More;
6use Math::Prime::Util qw/vecreduce
7                         vecextract
8                         vecmin vecmax
9                         vecsum vecprod factorial
10                         vecany vecall vecnotall vecnone vecfirst vecfirstidx/;
11
12my $extra = defined $ENV{EXTENDED_TESTING} && $ENV{EXTENDED_TESTING};
13my $use64 = Math::Prime::Util::prime_get_config->{'maxbits'} > 32;
14$use64 = 0 if $use64 && 18446744073709550592 == ~0;
15
16my @vecmins = (
17  [ ],
18  [ 1, 1 ],
19  [ 0, 0 ],
20  [ -1, -1 ],
21  [ 1, 1, 2 ],
22  [ 1, 2, 1 ],
23  [ 1, 2, 1 ],
24  [ -6, 0, 4, -5, 6, -6, 0 ],
25  [ -6, 0, 4, -5, 7, -6, 0 ],
26  [ "27944220269257565027", "81033966278481626507", "27944220269257565027" ],
27);
28if ($use64) {
29  # List::Util::min gets these wrong
30  push @vecmins, [ qw/18446744073702958477   18446744073704516093 18446744073706008451 18446744073706436837 18446744073707776433 18446744073702959347 18446744073702958477/ ];
31  push @vecmins, [ qw/-9223372036852260731   -9223372036852260673 -9223372036852260731 -9223372036850511139 -9223372036850207017 -9223372036852254557 -9223372036849473359/ ];
32  push @vecmins, [ qw/-9223372036853497843   9223372036852278343 -9223372036853497487 -9223372036844936897 -9223372036850971897 -9223372036853497843 9223372036848046999/ ];
33}
34my @vecmaxs = (
35  [ ],
36  [ 1, 1 ],
37  [ 0, 0 ],
38  [ -1, -1 ],
39  [ 2, 1, 2 ],
40  [ 2, 2, 1 ],
41  [ 2, 2, 1 ],
42  [  6, 0, 4, -5, 6, -6, 0 ],
43  [  7, 0, 4, -5, 7, -8, 0 ],
44  [ "81033966278481626507" , "27944220269257565027", "81033966278481626507" ],
45);
46if ($use64) {
47  # List::Util::max gets these wrong
48  push @vecmaxs, [ qw/18446744072030630259   18446744070011576186 18446744070972009258 18446744071127815503 18446744072030630259 18446744072030628952 18446744071413452589/ ];
49  push @vecmaxs, [ qw/18446744073707508539   18446744073702156661 18446744073707508539 18446744073700111529 18446744073707506771 18446744073707086091 18446744073704381821/ ];
50  push @vecmaxs, [ qw/-9223372036847631197   -9223372036853227739 -9223372036847631197 -9223372036851632173 -9223372036847631511 -9223372036852712261 -9223372036851707899/ ];
51  push @vecmaxs, [ qw/9223372036846154833   -9223372036846673813 9223372036846154833 -9223372036851103423 9223372036846154461 -9223372036849190963 -9223372036847538803/ ];
52}
53
54my @vecsums = (
55  [ 0 ],
56  [ -1, -1 ],
57  [ 0, 1,-1 ],
58  [ 0, -1,1 ],
59  [ 0, -1,1 ],
60  [ 0, -2147483648,2147483648 ],
61  [ 0, "-4294967296","4294967296" ],
62  [ 0, "-9223372036854775808","9223372036854775808" ],
63  [ "18446744073709551615", "18446744073709551615","-18446744073709551615","18446744073709551615" ],
64  [ "55340232221128654848", "18446744073709551616","18446744073709551616","18446744073709551616" ],
65);
66if ($use64) {
67  push @vecsums, [ "18446744073709620400", 18446744073709540400, (1000) x 80 ];
68}
69my @vecprods = (
70  [ 1 ],
71  [ 1,  1 ],
72  [ -1,  -1 ],
73  [ 2,  -1, -2 ],
74  [ 2,  -1, -2 ],
75  [ "-2147385345", 32767, -65535 ],
76  [ "-2147385345", 32767, -65535 ],
77  [ "-2147450880", 32768, -65535 ],
78  [ "-2147483648", 32768, -65536 ],
79);
80
81plan tests => 0
82            + scalar(@vecmins)
83            + scalar(@vecmaxs)
84            + scalar(@vecsums)
85            + 1 + scalar(@vecprods)
86            + 4    # vecreduce
87            + 2    # vecextract
88            + 3*4  # vec{any,all,notall,none}
89            + 5    # vecfirst
90            + 5    # vecfirstidx
91            + 0;
92
93###### vecmin
94foreach my $r (@vecmins) {
95  if (@$r == 0) {
96    is(vecmin(), undef, "vecmin() = undef");
97  } else {
98    my($exp, @vals) = @$r;
99    is( vecmin(@vals), $exp, "vecmin(@vals) = $exp" );
100  }
101}
102###### vecmax
103foreach my $r (@vecmaxs) {
104  if (@$r == 0) {
105    is(vecmax(), undef, "vecmax() = undef");
106  } else {
107    my($exp, @vals) = @$r;
108    is( vecmax(@vals), $exp, "vecmax(@vals) = $exp" );
109  }
110}
111
112###### vecsum
113foreach my $r (@vecsums) {
114  my($exp, @vals) = @$r;
115  is( vecsum(@vals), $exp, "vecsum(@vals) = $exp" );
116}
117###### vecprod
118foreach my $r (@vecprods) {
119  my($exp, @vals) = @$r;
120  is( vecprod(@vals), $exp, "vecprod(@vals) = $exp" );
121}
122{
123  my(@prod,@fact);
124  for my $f (0 .. 50) {
125    push @fact, factorial($f);
126    push @prod, vecprod(1 .. $f);
127  }
128  is_deeply(\@prod, \@fact, "vecprod matches factorial for 0 .. 50");
129}
130
131##### vecreduce
132{
133  my $fail = 0;
134  is(vecreduce(sub{ $a + $b },()), undef, "vecreduce with empty list is undef");
135  is(vecreduce(sub{ $fail = 1; 0; },(15)), 15+$fail, "vecreduce with (a) is a and does not call the sub");
136  is(vecreduce(sub{ $a ^ $b },(4,2)), 6, "vecreduce [xor] (4,2) => 6");
137  is(vecreduce(sub{ $a * $b**2 },(1, 17, 18, 19)), 17**2 * 18**2 * 19**2, "vecreduce product of squares");
138}
139###### vecextract
140{
141  is_deeply([vecextract(['a'..'z'],12345758)], [qw/b c d e h i n o s t u v x/], "vecextract bits");
142  is(join("", vecextract(['a'..'z'],[22,14,17,10,18])), "works", "vecextract list");
143}
144
145###### vec{any,all,notall,none}
146ok(  (vecany { $_ == 1 } 1, 2, 3), 'any true' );
147ok( !(vecany { $_ == 1 } 2, 3, 4), 'any false' );
148ok( !(vecany { 1 }), 'any empty list' );
149
150ok(  (vecall { $_ == 1 } 1, 1, 1), 'all true' );
151ok( !(vecall { $_ == 1 } 1, 2, 3), 'all false' );
152ok(  (vecall { 1 }), 'all empty list' );
153
154ok(  (vecnotall { $_ == 1 } 1, 2, 3), 'notall true' );
155ok( !(vecnotall { $_ == 1 } 1, 1, 1), 'notall false' );
156ok( !(vecnotall { 1 }), 'notall empty list' );
157
158ok(  (vecnone { $_ == 1 } 2, 3, 4), 'none true' );
159ok( !(vecnone { $_ == 1 } 1, 2, 3), 'none false' );
160ok(  (vecnone { 1 }), 'none empty list' );
161
162###### vecfirst
163{
164  my $v;
165  $v = vecfirst { 8 == ($_ - 1) } 9,4,5,6; is($v, 9, "first success");
166  $v = vecfirst { 0 } 1,2,3,4; is($v, undef, "first failure");
167  $v = vecfirst { 0 }; is($v, undef, "first empty list");
168  $v = vecfirst { $_->[1] le "e" and "e" le $_->[2] } [qw(a b c)], [qw(d e f)], [qw(g h i)];
169  is_deeply($v, [qw(d e f)], 'first with reference args');
170  $v = vecfirst {while(1) {return ($_>6)} } 2,4,6,12; is($v,12,"first returns in loop");
171}
172{
173  my $v;
174  $v = vecfirstidx { 8 == ($_ - 1) } 9,4,5,6; is($v, 0, "first idx success");
175  $v = vecfirstidx { 0 } 1,2,3,4; is($v, -1, "first idx failure");
176  $v = vecfirstidx { 0 }; is($v, -1, "first idx empty list");
177  $v = vecfirstidx { $_->[1] le "e" and "e" le $_->[2] } [qw(a b c)], [qw(d e f)], [qw(g h i)];  is($v, 1, "first idx with reference args");
178  $v = vecfirstidx {while(1) {return ($_>6)} } 2,4,6,12; is($v,3,"first idx returns in loop");
179}
180