11 my $o = tie @a, 'Tie::File', $file, autochomp => 0, autodefer => 0;
12 print $o ? "ok $N\n" : "not ok $N\n";
19 check_contents("rec0");
23 check_contents("rec0", "rec1");
25 check_contents("rec0", "rec1", "rec2");
27 # 12-20 same-length alterations
29 check_contents("new0", "rec1", "rec2");
31 check_contents("new0", "new1", "rec2");
33 check_contents("new0", "new1", "new2");
35 # 21-35 lengthening alterations
37 check_contents("long0", "new1", "new2");
39 check_contents("long0", "long1", "new2");
41 check_contents("long0", "long1", "long2");
43 check_contents("long0", "longer1", "long2");
45 check_contents("longer0", "longer1", "long2");
47 # 36-50 shortening alterations, including truncation
49 check_contents("short0", "longer1", "long2");
51 check_contents("short0", "short1", "long2");
53 check_contents("short0", "short1", "short2");
55 check_contents("short0", "sh1", "short2");
57 check_contents("sh0", "sh1", "short2");
59 # (51-56) file with holes
61 check_contents("sh0", "sh1", "short2", "", "rec4");
63 check_contents("sh0", "sh1", "short2", "rec3", "rec4");
65 # (57-59) zero out file
69 # (60-62) insert into the middle of an empty file
71 check_contents("", "", "", "rec3");
73 # (63-68) 20020326 You thought there would be a bug in STORE where if
74 # a cached record was false, STORE wouldn't see it at all. But you
75 # forgot that records always come back from the cache with the record
76 # separator attached, so they are unlikely to be false. The only
77 # really weird case is when the cached record is empty and the record
78 # separator is "0". Test that in 09_gen_rs.t.
80 check_contents("", "0", "", "rec3");
82 check_contents("", "whoops", "", "rec3");
84 # (69-72) make sure that undefs are treated correctly---they should
85 # be converted to empty records, and should not raise any warnings.
86 # (Some of these failed in 0.90. The change to _fixrec fixed them.)
89 my $good = 1; my $warn;
90 # If any of these raise warnings, we have a problem.
91 local $SIG{__WARN__} = sub { $good = 0; $warn = shift(); ctrlfix($warn)};
95 print $good ? "ok $N\n" : "not ok $N # $warn\n";
97 print defined($a[0]) ? "ok $N\n" : "not ok $N\n";
100 print defined($a[1]) ? "ok $N\n" : "not ok $N\n";
103 print $good ? "ok $N\n" : "not ok $N # $warn\n";
107 use POSIX 'SEEK_SET';
110 my $x = join $:, @c, '';
111 local *FH = $o->{fh};
112 seek FH, 0, SEEK_SET;
113 # my $open = open FH, "< $file";
115 { local $/; $a = <FH> }
116 $a = "" unless defined $a;
121 print "not ok $N\n# expected <$x>, got <$a>\n";
130 unless ($aa eq "$c[$_]$:") {
131 $msg = "expected <$c[$_]$:>, got <$aa>";
136 print $good ? "ok $N\n" : "not ok $N # $msg\n";
139 print $o->_check_integrity($file, $ENV{INTEGRITY})
140 ? "ok $N\n" : "not ok $N\n";
154 1 while unlink $file;