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