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