| 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 |
|
|---|