12 my $o = tie @a, 'Tie::File', $file,
13 recsep => $RECSEP, autochomp => 0, autodefer => 0;
14 print $o ? "ok $N\n" : "not ok $N\n";
20 check_contents("rec0");
24 check_contents("rec0", "rec1");
26 check_contents("rec0", "rec1", "rec2");
28 # 9-14 same-length alterations
30 check_contents("new0", "rec1", "rec2");
32 check_contents("new0", "new1", "rec2");
34 check_contents("new0", "new1", "new2");
36 # 15-24 lengthening alterations
38 check_contents("long0", "new1", "new2");
40 check_contents("long0", "long1", "new2");
42 check_contents("long0", "long1", "long2");
44 check_contents("long0", "longer1", "long2");
46 check_contents("longer0", "longer1", "long2");
48 # 25-34 shortening alterations, including truncation
50 check_contents("short0", "longer1", "long2");
52 check_contents("short0", "short1", "long2");
54 check_contents("short0", "short1", "short2");
56 check_contents("short0", "sh1", "short2");
58 check_contents("sh0", "sh1", "short2");
60 # (35-38) file with holes
62 check_contents("sh0", "sh1", "short2", "", "rec4");
64 check_contents("sh0", "sh1", "short2", "rec3", "rec4");
66 # (39-40) zero out file
70 # (41-42) insert into the middle of an empty file
72 check_contents("", "", "", "rec3");
74 # (43-47) 20020326 You thought there would be a bug in STORE where if
75 # a cached record was false, STORE wouldn't see it at all. Yup, there is,
76 # and adding the appropriate defined() test fixes the problem.
77 undef $o; untie @a; 1 while unlink $file;
79 $o = tie @a, 'Tie::File', $file,
80 recsep => $RECSEP, autochomp => 0, autodefer => 0;
81 print $o ? "ok $N\n" : "not ok $N\n";
84 my $z = $a[1]; # caches "0"
86 check_contents("", "", "oops");
88 check_contents("", "bah", "oops");
91 # (48-56) 20020331 Make sure we correctly handle the case where the final
92 # record of the file is not properly terminated, Through version 0.90,
93 # we would mangle the file.
94 my $badrec = "Malformed";
95 $: = $RECSEP = Tie::File::_default_recsep();
97 if (setup_badly_terminated_file(3)) {
98 $o = tie @a, 'Tie::File', $file,
99 recsep => $RECSEP, autochomp => 0, autodefer => 0
100 or die "Couldn't tie file: $!";
102 print $z eq "$badrec$:" ? "ok $N\n" :
103 "not ok $N \# got $z, expected $badrec\n";
106 check_contents($badrec, "next");
110 if (setup_badly_terminated_file(2)) {
111 $o = tie @a, 'Tie::File', $file,
112 recsep => $RECSEP, autochomp => 0, autodefer => 0
113 or die "Couldn't tie file: $!";
114 splice @a, 1, 0, "x", "y";
115 check_contents($badrec, "x", "y");
119 if (setup_badly_terminated_file(4)) {
120 $o = tie @a, 'Tie::File', $file,
121 recsep => $RECSEP, autochomp => 0, autodefer => 0
122 or die "Couldn't tie file: $!";
123 my @r = splice @a, 0, 1, "x", "y";
125 print $n == 1 ? "ok $N\n" : "not ok $N \# expected 1 elt, got $n\n";
127 print $r[0] eq "$badrec$:" ? "ok $N\n"
128 : "not ok $N \# expected <$badrec>, got <$r[0]>\n";
130 check_contents("x", "y");
134 # (57-58) 20020402 The modifiaction would have failed if $\ were set wrong.
136 if (setup_badly_terminated_file(2)) {
137 $o = tie @a, 'Tie::File', $file,
138 recsep => $RECSEP, autochomp => 0, autodefer => 0
139 or die "Couldn't tie file: $!";
140 { local $\ = "I hate \$\\.";
143 check_contents($badrec);
147 sub setup_badly_terminated_file {
149 open F, "> $file" or die "Couldn't open $file: $!";
153 unless (-s $file == length $badrec) {
155 print "ok $N \# skipped - can't create improperly terminated file\n";
164 use POSIX 'SEEK_SET';
167 my $x = join $RECSEP, @c, '';
168 local *FH = $o->{fh};
169 seek FH, 0, SEEK_SET;
171 { local $/; $a = <FH> }
173 $a = "" unless defined $a;
177 my $msg = "# expected <$x>, got <$a>";
179 print "not ok $N $msg\n";
186 unless ($a[$_] eq "$c[$_]$RECSEP") {
187 $msg = "expected $c[$_]$RECSEP, got $a[$_]";
192 print $good ? "ok $N\n" : "not ok $N # fetch $msg\n";
208 1 while unlink $file;