Commit | Line | Data |
a0cb3900 |
1 | #!/usr/bin/perl |
2 | |
5189e6fe |
3 | use lib '..'; |
a0cb3900 |
4 | use Memoize; |
5 | |
6 | my $n = 0; |
484fdf61 |
7 | $|=1; |
a0cb3900 |
8 | |
9 | |
10 | if (-e '.fast') { |
11 | print "1..0\n"; |
12 | exit 0; |
13 | } |
14 | |
899dc88a |
15 | print "1..12\n"; |
484fdf61 |
16 | # (1) |
a0cb3900 |
17 | ++$n; print "ok $n\n"; |
18 | |
19 | my $READFILE_CALLS = 0; |
20 | my $FILE = './TESTFILE'; |
21 | |
22 | sub writefile { |
23 | my $FILE = shift; |
24 | open F, "> $FILE" or die "Couldn't write temporary file $FILE: $!"; |
25 | print F scalar(localtime), "\n"; |
26 | close F; |
27 | } |
28 | |
29 | sub readfile { |
30 | $READFILE_CALLS++; |
31 | my $FILE = shift; |
5189e6fe |
32 | open F, "< $FILE" or die "Couldn't write temporary file $FILE: $!"; |
a0cb3900 |
33 | my $data = <F>; |
34 | close F; |
35 | $data; |
36 | } |
37 | |
899dc88a |
38 | require Memoize::ExpireFile; |
484fdf61 |
39 | # (2) |
899dc88a |
40 | ++$n; print "ok $n\n"; |
41 | |
42 | tie my %cache => 'Memoize::ExpireFile'; |
a0cb3900 |
43 | memoize 'readfile', |
899dc88a |
44 | SCALAR_CACHE => [HASH => \%cache], |
a0cb3900 |
45 | LIST_CACHE => 'FAULT' |
46 | ; |
47 | |
484fdf61 |
48 | # (3) |
a0cb3900 |
49 | ++$n; print "ok $n\n"; |
50 | |
484fdf61 |
51 | # (4) |
a0cb3900 |
52 | writefile($FILE); |
53 | ++$n; print "ok $n\n"; |
484fdf61 |
54 | sleep 4; |
a0cb3900 |
55 | |
484fdf61 |
56 | # (5-6) |
a0cb3900 |
57 | my $t1 = readfile($FILE); |
58 | ++$n; print "ok $n\n"; |
59 | ++$n; print ((($READFILE_CALLS == 1) ? '' : 'not '), "ok $n\n"); |
60 | |
484fdf61 |
61 | # (7-9) |
a0cb3900 |
62 | my $t2 = readfile($FILE); |
484fdf61 |
63 | ++$n; print "ok $n\n"; |
a0cb3900 |
64 | ++$n; print ((($READFILE_CALLS == 1) ? '' : 'not '), "ok $n\n"); |
65 | ++$n; print ((($t1 eq $t2) ? '' : 'not '), "ok $n\n"); |
66 | |
484fdf61 |
67 | # (10-12) |
68 | sleep 4; |
a0cb3900 |
69 | writefile($FILE); |
70 | my $t3 = readfile($FILE); |
71 | ++$n; print "ok $n\n"; |
72 | ++$n; print ((($READFILE_CALLS == 2) ? '' : 'not '), "ok $n\n"); |
73 | ++$n; print ((($t1 ne $t3) ? '' : 'not '), "ok $n\n"); |
74 | |
899dc88a |
75 | END { 1 while unlink $FILE } |