lib/Memoize/t/array.t

   1 #!/usr/bin/perl
   2
   3 use lib '..';
   4 use Memoize;
   5
   6
   7 print "1..11\n";
   8
   9 sub timelist {
  10   return (time) x $_[0];
  11 }
  12
  13 memoize('timelist');
  14
  15 @t1 = &timelist(1);
  16 sleep 2;
  17 @u1 = &timelist(1);
  18 print ((("@t1" eq "@u1") ? '' : 'not '), "ok 1\n");
  19
  20 @t7 = &timelist(7);
  21 print (((@t7 == 7) ? '' : 'not '), "ok 2\n");
  22 $BAD = 0;
  23 for ($i = 1; $i < 7; $i++) {
  24   $BAD++ unless $t7[$i-1] == $t7[$i];
  25 }
  26 print (($BAD ? 'not ' : ''), "ok 3\n");
  27
  28 sleep 2;
  29 @u7 = &timelist(7);
  30 print (((@u7 == 7) ? '' : 'not '), "ok 4\n");
  31 $BAD = 0;
  32 for ($i = 1; $i < 7; $i++) {
  33   $BAD++ unless $u7[$i-1] == $u7[$i];
  34 }
  35 print (($BAD ? 'not ' : ''), "ok 5\n");
  36 # Properly memoized?
  37 print ((("@t7" eq "@u7") ? '' : 'not '), "ok 6\n");
  38
  39 sub con {
  40   return wantarray()
  41 }
  42
  43 # Same arguments yield different results in different contexts?
  44 memoize('con');
  45 $s = con(1);
  46 @a = con(1);
  47 print ((($s == $a[0]) ? 'not ' : ''), "ok 7\n");
  48
  49 # Context propagated correctly?
  50 print ((($s eq '') ? '' : 'not '), "ok 8\n"); # Scalar context
  51 print ((("@a" eq '1' && @a == 1) ? '' : 'not '), "ok 9\n"); # List context
  52
  53 # Context propagated correctly to normalizer?
  54 sub n {
  55   my $arg = shift;
  56   my $test = shift;
  57   if (wantarray) {
  58     print ((($arg eq ARRAY) ? '' : 'not '), "ok $test\n"); # List context
  59   } else {
  60     print ((($arg eq SCALAR) ? '' : 'not '), "ok $test\n"); # Scalar context
  61   }
  62 }
  63
  64 sub f { 1 }
  65 memoize('f', NORMALIZER => 'n');
  66 $s = f('SCALAR', 10);           # Test 10
  67 @a = f('ARRAY' , 11);           # Test 11
  68