lib/Memoize/t/array.t

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