cpan/List-Util/t/product.t

   1 #!./perl
   2
   3 BEGIN {
   4     unless (-d 'blib') {
   5         chdir 't' if -d 't';
   6         @INC = '../lib';
   7         require Config; import Config;
   8         keys %Config; # Silence warning
   9         if ($Config{extensions} !~ /\bList\/Util\b/) {
  10             print "1..0 # Skip: List::Util was not built\n";
  11             exit 0;
  12         }
  13     }
  14 }
  15
  16 use Test::More tests => 13;
  17
  18 use List::Util qw(product);
  19
  20 my $v = product;
  21 is( $v, 1, 'no args');
  22
  23 $v = product(9);
  24 is( $v, 9, 'one arg');
  25
  26 $v = product(1,2,3,4);
  27 is( $v, 24, '4 args');
  28
  29 $v = product(-1);
  30 is( $v, -1, 'one -1');
  31
  32 my $x = -3;
  33
  34 $v = product($x, 3);
  35 is( $v, -9, 'variable arg');
  36
  37 $v = product(-3.5,3);
  38 is( $v, -10.5, 'real numbers');
  39
  40 my $one  = Foo->new(1);
  41 my $two  = Foo->new(2);
  42 my $four = Foo->new(4);
  43
  44 $v = product($one,$two,$four);
  45 is($v, 8, 'overload');
  46
  47
  48 { package Foo;
  49
  50 use overload
  51   '""' => sub { ${$_[0]} },
  52   '+0' => sub { ${$_[0]} },
  53   fallback => 1;
  54   sub new {
  55     my $class = shift;
  56     my $value = shift;
  57     bless \$value, $class;
  58   }
  59 }
  60
  61 use Math::BigInt;
  62 my $v1 = Math::BigInt->new(2) ** Math::BigInt->new(65);
  63 my $v2 = $v1 - 1;
  64 $v = product($v1,$v2);
  65 is($v, $v1 * $v2, 'bigint');
  66
  67 $v = product(42, $v1);
  68 is($v, $v1 * 42, 'bigint + builtin int');
  69
  70 $v = product(42, $v1, 2);
  71 is($v, $v1 * 42 * 2, 'bigint + builtin int');
  72
  73 { package example;
  74
  75   use overload
  76     '0+' => sub { $_[0][0] },
  77     '""' => sub { my $r = "$_[0][0]"; $r = "+$r" unless $r =~ m/^\-/; $r .= " [$_[0][1]]"; $r },
  78     fallback => 1;
  79
  80   sub new {
  81     my $class = shift;
  82
  83     my $this = bless [@_], $class;
  84
  85     return $this;
  86   }
  87 }
  88
  89 {
  90   my $e1 = example->new(7, "test");
  91   $t = product($e1, 7, 7);
  92   is($t, 343, 'overload returning non-overload');
  93   $t = product(8, $e1, 8);
  94   is($t, 448, 'overload returning non-overload');
  95   $t = product(9, 9, $e1);
  96   is($t, 567, 'overload returning non-overload');
  97 }
  98