4 $: = Tie::File::_default_recsep();
10 print "ok $N\n"; $N++;
12 my $o = tie @a, 'Tie::File', $file, autochomp => 1;
13 print $o ? "ok $N\n" : "not ok $N\n";
18 check_contents("rec0");
22 check_contents("rec0", "rec1");
24 check_contents("rec0", "rec1", "rec2");
26 # 12-20 same-length alterations
28 check_contents("new0", "rec1", "rec2");
30 check_contents("new0", "new1", "rec2");
32 check_contents("new0", "new1", "new2");
34 # 21-35 lengthening alterations
36 check_contents("long0", "new1", "new2");
38 check_contents("long0", "long1", "new2");
40 check_contents("long0", "long1", "long2");
42 check_contents("long0", "longer1", "long2");
44 check_contents("longer0", "longer1", "long2");
46 # 36-50 shortening alterations, including truncation
48 check_contents("short0", "longer1", "long2");
50 check_contents("short0", "short1", "long2");
52 check_contents("short0", "short1", "short2");
54 check_contents("short0", "sh1", "short2");
56 check_contents("sh0", "sh1", "short2");
58 # (51-56) file with holes
60 check_contents("sh0", "sh1", "short2", "", "rec4");
62 check_contents("sh0", "sh1", "short2", "rec3", "rec4");
64 # (57-59) zero out file
68 # (60-62) insert into the middle of an empty file
70 check_contents("", "", "", "rec3");
72 # (63-68) Test the ->autochomp() method
73 @a = qw(Gold Frankincense Myrrh);
75 $ac = $o->autochomp();
77 # See if that accidentally changed it
78 $ac = $o->autochomp();
81 $ac = $o->autochomp(0);
83 expect(join("-", @a), "Gold$:-Frankincense$:-Myrrh$:");
85 $ac = $o->autochomp(1);
87 expect(join("-", @a), "Gold-Frankincense-Myrrh");
89 # (69) Does 'splice' work correctly with autochomp?
91 @sr = splice @a, 0, 2;
92 expect(join("-", @sr), "Gold-Frankincense");
94 # (70-71) Didn't you forget that fetch may return an unchomped cached record?
95 $a1 = $a[0]; # populate cache
99 # Actually no, you didn't---_fetch might return such a record, but
100 # the chomping is done by FETCH.
102 use POSIX 'SEEK_SET';
105 my $x = join $:, @c, '';
106 local *FH = $o->{fh};
107 seek FH, 0, SEEK_SET;
108 # my $open = open FH, "< $file";
110 { local $/; $a = <FH> }
111 $a = "" unless defined $a;
116 print "not ok $N\n# expected <$x>, got <$a>\n";
125 unless ($aa eq $c[$_]) {
126 $msg = "expected <$c[$_]>, got <$aa>";
131 print $good ? "ok $N\n" : "not ok $N # $msg\n";
134 print $o->_check_integrity($file, $ENV{INTEGRITY})
135 ? "ok $N\n" : "not ok $N\n";
141 print $_[0] ? "ok $N\n" : "not ok $N\n";
144 if (! defined($a) && ! defined($x)) { print "ok $N\n" }
145 elsif ( defined($a) && ! defined($x)) {
146 ctrlfix(my $msg = "expected UNDEF, got <$a>");
147 print "not ok $N \# $msg\n";
149 elsif (! defined($a) && defined($x)) {
150 ctrlfix(my $msg = "expected <$x>, got UNDEF");
151 print "not ok $N \# $msg\n";
152 } elsif ($a eq $x) { print "ok $N\n" }
154 ctrlfix(my $msg = "expected <$x>, got <$a>");
155 print "not ok $N \# $msg\n";
158 die "expect() got ", scalar(@_), " args, should have been 1 or 2";
173 1 while unlink $file;