Commit | Line | Data |
a0cb3900 |
1 | #!/usr/bin/perl |
2 | |
5317c87c |
3 | BEGIN { |
4 | chdir 't' if -d 't'; |
5 | @INC = '../lib'; |
6 | } |
a0cb3900 |
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 | |