Commit | Line | Data |
a0cb3900 |
1 | #!/usr/bin/perl |
2 | |
484fdf61 |
3 | use lib '..'; |
a0cb3900 |
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 | |