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# Ten seconds should be plenty of time for it to complete if it works 48# on an unloaded box. Using 20 under parallel builds seems prudent. 49my $alarm_time = $ENV{TEST_JOBS} || $ENV{HARNESS_OPTIONS} ? 20 : 10; 50local $SIG{ALRM} = sub { die "$0 Timeout after $alarm_time seconds at test 3\n" }; 51alarm $alarm_time unless $^P; 52@a = "record0" .. "record9"; 53print "ok 3\n"; 54alarm 0; 55 56END { 57 undef $o; 58 untie @a; 59 1 while unlink $file; 60} 61