3 # Check behavior of 'autodefer' feature
4 # Mostly this isn't implemented yet
5 # This file is primarily here to make sure that the promised ->autodefer
6 # method doesn't croak.
11 my $file = "tf$$.txt";
12 $: = Tie::File::_default_recsep();
13 my $data = "rec0$:rec1$:rec2$:";
20 print "ok $N\n"; $N++;
22 open F, "> $file" or die $!;
26 $o = tie @a, 'Tie::File', $file;
27 print $o ? "ok $N\n" : "not ok $N\n";
30 # I am an undocumented feature
31 $o->{autodefer_filelen_threshhold} = 0;
32 # Normally autodeferring only works on large files. This disables that.
34 # (3-22) Deferred storage
36 check_autodeferring('OFF');
38 check_autodeferring('OFF');
40 check_autodeferring('ON');
41 check_contents($data . "rec3$:rec4$:"); # only the first two were written
43 check_autodeferring('ON');
44 check_contents($data . "rec3$:rec4$:"); # still nothing written
46 check_autodeferring('ON');
47 check_contents($data . "rec3$:rec4$:"); # still nothing written
49 check_autodeferring('OFF');
50 check_contents("recX$:rec1$:rec2$:rec3$:rec4$:rec5$:rec6$:rec7$:");
52 check_autodeferring('OFF');
53 check_contents("recX$:recY$:rec2$:rec3$:rec4$:rec5$:rec6$:rec7$:");
54 $a[2] = "recZ"; # it kicks in here
55 check_autodeferring('ON');
56 check_contents("recX$:recY$:rec2$:rec3$:rec4$:rec5$:rec6$:rec7$:");
58 # (23-26) Explicitly enabling deferred writing deactivates autodeferring
60 check_autodeferring('OFF');
61 check_contents("recX$:recY$:recZ$:rec3$:rec4$:rec5$:rec6$:rec7$:");
63 check_autodeferring('OFF');
65 # (27-32) Now let's try the CLEAR special case
67 check_autodeferring('ON');
68 # The file was extended to the right length, but nothing was actually written.
69 check_contents("$:$:$:$:$:");
71 check_autodeferring('OFF');
72 check_contents("r0$:r1$:fish$:r3$:r4$:");
74 # (33-47) Now let's try the originally intended application: a 'for' loop.
79 check_autodeferring('OFF');
80 check_contents("##r0$:r1$:fish$:r3$:r4$:");
82 check_autodeferring('OFF');
83 check_contents("##r0$:##r1$:fish$:r3$:r4$:");
85 check_autodeferring('ON');
86 check_contents("##r0$:##r1$:fish$:r3$:r4$:");
91 # (48-56) Autodeferring should not become active during explicit defer mode
92 $o->defer(); # This should flush the pending autodeferred records
93 # and deactivate autodeferring
94 check_autodeferring('OFF');
95 check_contents("##r0$:##r1$:##fish$:##r3$:##r4$:");
97 check_autodeferring('OFF');
100 check_autodeferring('OFF');
101 check_contents("s0$:s1$:s2$:s3$:s4$:");
105 # Limit cache+buffer size to 47 bytes
107 # -- that's enough space for 5 records, but not 6, on both \n and \r\n systems
109 # -- that's enough space for 2 records, but not 3, on both \n and \r\n systems
110 # Re-tie the object for more tests
111 $o = tie @a, 'Tie::File', $file, autodefer => 0;
113 # I am an undocumented feature
114 $o->{autodefer_filelen_threshhold} = 0;
115 # Normally autodeferring only works on large files. This disables that.
117 # (57-59) Did the autodefer => 0 option work?
118 # (If it doesn't, a whole bunch of the other test files will fail.)
120 check_autodeferring('OFF');
121 check_contents(join("$:", qw(0 1 2 3), ""));
123 # (60-62) Does the ->autodefer method work?
126 check_autodeferring('ON');
127 check_contents("$:$:$:$:"); # This might be unfortunate.
129 # (63-65) Does the ->autodefer method work?
131 check_autodeferring('OFF');
132 check_contents(join("$:", qw(10 11 12 13), ""));
135 sub check_autodeferring {
137 my $a = $o->{autodeferring} ? 'ON' : 'OFF';
141 print "not ok $N \# Autodeferring was $a, expected it to be $x\n";
149 # for (values %{$o->{cache}}) {
150 # print "# cache=$_";
153 my $integrity = $o->_check_integrity($file, $ENV{INTEGRITY});
154 local *FH = $o->{fh};
155 seek FH, 0, SEEK_SET;
156 print $integrity ? "ok $N\n" : "not ok $N\n";
159 { local $/; $a = <FH> }
160 $a = "" unless defined $a;
164 ctrlfix(my $msg = "# expected <$x>, got <$a>");
165 print "not ok $N\n$msg\n";
180 1 while unlink $file;