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