1#!/usr/bin/perl 2# 3# Tests for various caching errors 4# 5 6use strict; 7use warnings; 8 9use Config; 10 11my $file = "tf24-$$.txt"; 12unless ($Config{d_alarm}) { 13 print "1..0\n"; exit; 14} 15 16$: = Tie::File::_default_recsep(); 17my $data = join $:, "record0" .. "record9", ""; 18my $V = $ENV{INTEGRITY}; # Verbose integrity checking? 19 20print "1..3\n"; 21 22my $N = 1; 23use Tie::File; 24print "ok $N\n"; $N++; 25 26open F, '>', $file or die $!; 27binmode F; 28print F $data; 29close F; 30 31# Limit cache size to 30 bytes 32my $MAX = 30; 33# -- that's enough space for 3 records, but not 4, on both \n and \r\n systems 34my @a; 35my $o = tie @a, 'Tie::File', $file, memory => $MAX, autodefer => 1; 36print $o ? "ok $N\n" : "not ok $N\n"; 37$N++; 38 39# (3) In 0.50 this goes into an infinite loop. Explanation: 40# 41# Suppose you overfill the defer buffer by so much that the memory 42# limit is also exceeded. You'll go into _splice to prepare to 43# write out the defer buffer, and _splice will call _fetch, which 44# will then try to flush the read cache---but the read cache is 45# already empty, so you're stuck in an infinite loop. 46# 47# Five seconds should be plenty of time for it to complete if it works. 48alarm 5 unless $^P; 49@a = "record0" .. "record9"; 50print "ok 3\n"; 51alarm 0; 52 53END { 54 undef $o; 55 untie @a; 56 1 while unlink $file; 57} 58 59 60 61