| Line | |
|---|
| 1 | #!/usr/bin/perl
|
|---|
| 2 |
|
|---|
| 3 | use lib '..';
|
|---|
| 4 | use Memoize;
|
|---|
| 5 |
|
|---|
| 6 | my $n = 0;
|
|---|
| 7 | $|=1;
|
|---|
| 8 |
|
|---|
| 9 |
|
|---|
| 10 | if (-e '.fast') {
|
|---|
| 11 | print "1..0\n";
|
|---|
| 12 | exit 0;
|
|---|
| 13 | }
|
|---|
| 14 |
|
|---|
| 15 | print "1..12\n";
|
|---|
| 16 | # (1)
|
|---|
| 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;
|
|---|
| 32 | open F, "< $FILE" or die "Couldn't write temporary file $FILE: $!";
|
|---|
| 33 | my $data = <F>;
|
|---|
| 34 | close F;
|
|---|
| 35 | $data;
|
|---|
| 36 | }
|
|---|
| 37 |
|
|---|
| 38 | require Memoize::ExpireFile;
|
|---|
| 39 | # (2)
|
|---|
| 40 | ++$n; print "ok $n\n";
|
|---|
| 41 |
|
|---|
| 42 | tie my %cache => 'Memoize::ExpireFile';
|
|---|
| 43 | memoize 'readfile',
|
|---|
| 44 | SCALAR_CACHE => [HASH => \%cache],
|
|---|
| 45 | LIST_CACHE => 'FAULT'
|
|---|
| 46 | ;
|
|---|
| 47 |
|
|---|
| 48 | # (3)
|
|---|
| 49 | ++$n; print "ok $n\n";
|
|---|
| 50 |
|
|---|
| 51 | # (4)
|
|---|
| 52 | writefile($FILE);
|
|---|
| 53 | ++$n; print "ok $n\n";
|
|---|
| 54 | sleep 4;
|
|---|
| 55 |
|
|---|
| 56 | # (5-6)
|
|---|
| 57 | my $t1 = readfile($FILE);
|
|---|
| 58 | ++$n; print "ok $n\n";
|
|---|
| 59 | ++$n; print ((($READFILE_CALLS == 1) ? '' : 'not '), "ok $n\n");
|
|---|
| 60 |
|
|---|
| 61 | # (7-9)
|
|---|
| 62 | my $t2 = readfile($FILE);
|
|---|
| 63 | ++$n; print "ok $n\n";
|
|---|
| 64 | ++$n; print ((($READFILE_CALLS == 1) ? '' : 'not '), "ok $n\n");
|
|---|
| 65 | ++$n; print ((($t1 eq $t2) ? '' : 'not '), "ok $n\n");
|
|---|
| 66 |
|
|---|
| 67 | # (10-12)
|
|---|
| 68 | sleep 4;
|
|---|
| 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 |
|
|---|
| 75 | END { 1 while unlink $FILE }
|
|---|
Note:
See
TracBrowser
for help on using the repository browser.