1#!./perl 2 3use strict; 4use warnings; 5 6use Test::More tests => 27; 7 8use Config; 9use List::Util qw(product); 10 11my $v = product; 12is( $v, 1, 'no args'); 13 14$v = product(9); 15is( $v, 9, 'one arg'); 16 17$v = product(1,2,3,4); 18is( $v, 24, '4 args'); 19 20$v = product(-1); 21is( $v, -1, 'one -1'); 22 23$v = product(0, 1, 2); 24is( $v, 0, 'first factor zero' ); 25 26$v = product(0, 1); 27is( $v, 0, '0 * 1'); 28 29$v = product(1, 0); 30is( $v, 0, '1 * 0'); 31 32$v = product(0, 0); 33is( $v, 0, 'two 0'); 34 35# RT139601 cornercases 36{ 37 # Numify the result because some older perl versions see "-0" as a string 38 is( 0+product(-1.0, 0), 0, 'product(-1.0, 0)' ); 39 is( 0+product(-1, 0), 0, 'product(-1, 0)' ); 40} 41 42my $x = -3; 43 44$v = product($x, 3); 45is( $v, -9, 'variable arg'); 46 47$v = product(-3.5,3); 48is( $v, -10.5, 'real numbers'); 49 50my $one = Foo->new(1); 51my $two = Foo->new(2); 52my $four = Foo->new(4); 53 54$v = product($one,$two,$four); 55is($v, 8, 'overload'); 56 57 58{ package Foo; 59 60use overload 61 '""' => sub { ${$_[0]} }, 62 '0+' => sub { ${$_[0]} }, 63 fallback => 1; 64 sub new { 65 my $class = shift; 66 my $value = shift; 67 bless \$value, $class; 68 } 69} 70 71use Math::BigInt; 72my $v1 = Math::BigInt->new(2) ** Math::BigInt->new(65); 73my $v2 = $v1 - 1; 74$v = product($v1,$v2); 75is($v, $v1 * $v2, 'bigint'); 76 77$v = product(42, $v1); 78is($v, $v1 * 42, 'bigint + builtin int'); 79 80$v = product(42, $v1, 2); 81is($v, $v1 * 42 * 2, 'bigint + builtin int'); 82 83{ package example; 84 85 use overload 86 '0+' => sub { $_[0][0] }, 87 '""' => sub { my $r = "$_[0][0]"; $r = "+$r" unless $r =~ m/^\-/; $r .= " [$_[0][1]]"; $r }, 88 fallback => 1; 89 90 sub new { 91 my $class = shift; 92 93 my $this = bless [@_], $class; 94 95 return $this; 96 } 97} 98 99{ 100 my $e1 = example->new(7, "test"); 101 my $t = product($e1, 7, 7); 102 is($t, 343, 'overload returning non-overload'); 103 $t = product(8, $e1, 8); 104 is($t, 448, 'overload returning non-overload'); 105 $t = product(9, 9, $e1); 106 is($t, 567, 'overload returning non-overload'); 107} 108 109SKIP: { 110 skip "IV is not at least 64bit", 8 unless $Config{ivsize} >= 8; 111 112 my $t; 113 my $min = -(1<<31); 114 my $max = (1<<31)-1; 115 116 $t = product($min, $min); 117 is($t, 1<<62, 'min * min'); 118 $t = product($min, $max); 119 is($t, (1<<31) - (1<<62), 'min * max'); 120 $t = product($max, $min); 121 is($t, (1<<31) - (1<<62), 'max * min'); 122 123 $t = product($max, $max); 124 is($t, 4611686014132420609, 'max * max'); # (1<<62)-(1<<32)+1), but Perl 5.6 does not compute constant correctly 125 126 $t = product($min*8, $min); 127 cmp_ok($t, '>', (1<<61), 'min*8*min'); # may be an NV 128 $t = product($min*8, $max); 129 cmp_ok($t, '<', -(1<<61), 'min*8*max'); # may be an NV 130 $t = product($max, $min*8); 131 cmp_ok($t, '<', -(1<<61), 'min*max*8'); # may be an NV 132 $t = product($max, $max*8); 133 cmp_ok($t, '>', (1<<61), 'max*max*8'); # may be an NV 134 135} 136