1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
|
#!/usr/bin/perl
#
# Check behavior of 'autodefer' feature
# Mostly this isn't implemented yet
# This file is primarily here to make sure that the promised ->autodefer
# method doesn't croak.
#
use POSIX 'SEEK_SET';
my $file = "tf$$.txt";
$: = Tie::File::_default_recsep();
my $data = "rec0$:rec1$:rec2$:";
my ($o, $n, @a);
print "1..65\n";
my $N = 1;
use Tie::File;
print "ok $N\n"; $N++;
open F, "> $file" or die $!;
binmode F;
print F $data;
close F;
$o = tie @a, 'Tie::File', $file;
print $o ? "ok $N\n" : "not ok $N\n";
$N++;
# I am an undocumented feature
$o->{autodefer_filelen_threshhold} = 0;
# Normally autodeferring only works on large files. This disables that.
# (3-22) Deferred storage
$a[3] = "rec3";
check_autodeferring('OFF');
$a[4] = "rec4";
check_autodeferring('OFF');
$a[5] = "rec5";
check_autodeferring('ON');
check_contents($data . "rec3$:rec4$:"); # only the first two were written
$a[6] = "rec6";
check_autodeferring('ON');
check_contents($data . "rec3$:rec4$:"); # still nothing written
$a[7] = "rec7";
check_autodeferring('ON');
check_contents($data . "rec3$:rec4$:"); # still nothing written
$a[0] = "recX";
check_autodeferring('OFF');
check_contents("recX$:rec1$:rec2$:rec3$:rec4$:rec5$:rec6$:rec7$:");
$a[1] = "recY";
check_autodeferring('OFF');
check_contents("recX$:recY$:rec2$:rec3$:rec4$:rec5$:rec6$:rec7$:");
$a[2] = "recZ"; # it kicks in here
check_autodeferring('ON');
check_contents("recX$:recY$:rec2$:rec3$:rec4$:rec5$:rec6$:rec7$:");
# (23-26) Explicitly enabling deferred writing deactivates autodeferring
$o->defer;
check_autodeferring('OFF');
check_contents("recX$:recY$:recZ$:rec3$:rec4$:rec5$:rec6$:rec7$:");
$o->discard;
check_autodeferring('OFF');
# (27-32) Now let's try the CLEAR special case
@a = ("r0" .. "r4");
check_autodeferring('ON');
# The file was extended to the right length, but nothing was actually written.
check_contents("$:$:$:$:$:");
$a[2] = "fish";
check_autodeferring('OFF');
check_contents("r0$:r1$:fish$:r3$:r4$:");
# (33-47) Now let's try the originally intended application: a 'for' loop.
my $it = 0;
for (@a) {
$_ = "##$_";
if ($it == 0) {
check_autodeferring('OFF');
check_contents("##r0$:r1$:fish$:r3$:r4$:");
} elsif ($it == 1) {
check_autodeferring('OFF');
check_contents("##r0$:##r1$:fish$:r3$:r4$:");
} else {
check_autodeferring('ON');
check_contents("##r0$:##r1$:fish$:r3$:r4$:");
}
$it++;
}
# (48-56) Autodeferring should not become active during explicit defer mode
$o->defer(); # This should flush the pending autodeferred records
# and deactivate autodeferring
check_autodeferring('OFF');
check_contents("##r0$:##r1$:##fish$:##r3$:##r4$:");
@a = ("s0" .. "s4");
check_autodeferring('OFF');
check_contents("");
$o->flush;
check_autodeferring('OFF');
check_contents("s0$:s1$:s2$:s3$:s4$:");
undef $o; untie @a;
# Limit cache+buffer size to 47 bytes
my $MAX = 47;
# -- that's enough space for 5 records, but not 6, on both \n and \r\n systems
my $BUF = 20;
# -- that's enough space for 2 records, but not 3, on both \n and \r\n systems
# Re-tie the object for more tests
$o = tie @a, 'Tie::File', $file, autodefer => 0;
die $! unless $o;
# I am an undocumented feature
$o->{autodefer_filelen_threshhold} = 0;
# Normally autodeferring only works on large files. This disables that.
# (57-59) Did the autodefer => 0 option work?
# (If it doesn't, a whole bunch of the other test files will fail.)
@a = (0..3);
check_autodeferring('OFF');
check_contents(join("$:", qw(0 1 2 3), ""));
# (60-62) Does the ->autodefer method work?
$o->autodefer(1);
@a = (10..13);
check_autodeferring('ON');
check_contents("$:$:$:$:"); # This might be unfortunate.
# (63-65) Does the ->autodefer method work?
$o->autodefer(0);
check_autodeferring('OFF');
check_contents(join("$:", qw(10 11 12 13), ""));
sub check_autodeferring {
my ($x) = shift;
my $a = $o->{autodeferring} ? 'ON' : 'OFF';
if ($x eq $a) {
print "ok $N\n";
} else {
print "not ok $N \# Autodeferring was $a, expected it to be $x\n";
}
$N++;
}
sub check_contents {
my $x = shift;
# for (values %{$o->{cache}}) {
# print "# cache=$_";
# }
my $integrity = $o->_check_integrity($file, $ENV{INTEGRITY});
local *FH = $o->{fh};
seek FH, 0, SEEK_SET;
print $integrity ? "ok $N\n" : "not ok $N\n";
$N++;
my $a;
{ local $/; $a = <FH> }
$a = "" unless defined $a;
if ($a eq $x) {
print "ok $N\n";
} else {
ctrlfix(my $msg = "# expected <$x>, got <$a>");
print "not ok $N\n$msg\n";
}
$N++;
}
sub ctrlfix {
for (@_) {
s/\n/\\n/g;
s/\r/\\r/g;
}
}
END {
undef $o;
untie @a;
1 while unlink $file;
}
|
