Commit | Line | Data |
27531ffb |
1 | #!/usr/bin/perl |
2 | # |
3 | # Regular read-write tests with caching disabled |
4 | # (Same as 01_gen.t) |
5 | # |
27531ffb |
6 | my $file = "tf$$.txt"; |
7 | |
8 | print "1..68\n"; |
9 | |
10 | my $N = 1; |
11 | use Tie::File; |
12 | print "ok $N\n"; $N++; |
13 | |
14 | my $o = tie @a, 'Tie::File', $file, autochomp => 0, autodefer => 0, memory => 0; |
15 | print $o ? "ok $N\n" : "not ok $N\n"; |
16 | $N++; |
17 | |
18 | $: = $o->{recsep}; |
19 | |
20 | # 3-5 create |
21 | $a[0] = 'rec0'; |
22 | check_contents("rec0"); |
23 | |
24 | # 6-11 append |
25 | $a[1] = 'rec1'; |
26 | check_contents("rec0", "rec1"); |
27 | $a[2] = 'rec2'; |
28 | check_contents("rec0", "rec1", "rec2"); |
29 | |
30 | # 12-20 same-length alterations |
31 | $a[0] = 'new0'; |
32 | check_contents("new0", "rec1", "rec2"); |
33 | $a[1] = 'new1'; |
34 | check_contents("new0", "new1", "rec2"); |
35 | $a[2] = 'new2'; |
36 | check_contents("new0", "new1", "new2"); |
37 | |
38 | # 21-35 lengthening alterations |
39 | $a[0] = 'long0'; |
40 | check_contents("long0", "new1", "new2"); |
41 | $a[1] = 'long1'; |
42 | check_contents("long0", "long1", "new2"); |
43 | $a[2] = 'long2'; |
44 | check_contents("long0", "long1", "long2"); |
45 | $a[1] = 'longer1'; |
46 | check_contents("long0", "longer1", "long2"); |
47 | $a[0] = 'longer0'; |
48 | check_contents("longer0", "longer1", "long2"); |
49 | |
50 | # 36-50 shortening alterations, including truncation |
51 | $a[0] = 'short0'; |
52 | check_contents("short0", "longer1", "long2"); |
53 | $a[1] = 'short1'; |
54 | check_contents("short0", "short1", "long2"); |
55 | $a[2] = 'short2'; |
56 | check_contents("short0", "short1", "short2"); |
57 | $a[1] = 'sh1'; |
58 | check_contents("short0", "sh1", "short2"); |
59 | $a[0] = 'sh0'; |
60 | check_contents("sh0", "sh1", "short2"); |
61 | |
62 | # (51-56) file with holes |
63 | $a[4] = 'rec4'; |
64 | check_contents("sh0", "sh1", "short2", "", "rec4"); |
65 | $a[3] = 'rec3'; |
66 | check_contents("sh0", "sh1", "short2", "rec3", "rec4"); |
67 | |
68 | # (57-59) zero out file |
69 | @a = (); |
70 | check_contents(); |
71 | |
72 | # (60-62) insert into the middle of an empty file |
73 | $a[3] = "rec3"; |
74 | check_contents("", "", "", "rec3"); |
75 | |
76 | # (63-68) 20020326 You thought there would be a bug in STORE where if |
77 | # a cached record was false, STORE wouldn't see it at all. But you |
78 | # forgot that records always come back from the cache with the record |
79 | # separator attached, so they are unlikely to be false. The only |
80 | # really weird case is when the cached record is empty and the record |
81 | # separator is "0". Test that in 09_gen_rs.t. |
82 | $a[1] = "0"; |
83 | check_contents("", "0", "", "rec3"); |
84 | $a[1] = "whoops"; |
85 | check_contents("", "whoops", "", "rec3"); |
86 | |
87 | |
88 | use POSIX 'SEEK_SET'; |
89 | sub check_contents { |
90 | my @c = @_; |
91 | my $x = join $:, @c, ''; |
92 | local *FH = $o->{fh}; |
93 | seek FH, 0, SEEK_SET; |
94 | # my $open = open FH, "< $file"; |
95 | my $a; |
96 | { local $/; $a = <FH> } |
97 | $a = "" unless defined $a; |
98 | if ($a eq $x) { |
99 | print "ok $N\n"; |
100 | } else { |
101 | ctrlfix($a, $x); |
102 | print "not ok $N\n# expected <$x>, got <$a>\n"; |
103 | } |
104 | $N++; |
105 | |
106 | # now check FETCH: |
107 | my $good = 1; |
108 | my $msg; |
109 | for (0.. $#c) { |
110 | my $aa = $a[$_]; |
111 | unless ($aa eq "$c[$_]$:") { |
112 | $msg = "expected <$c[$_]$:>, got <$aa>"; |
113 | ctrlfix($msg); |
114 | $good = 0; |
115 | } |
116 | } |
117 | print $good ? "ok $N\n" : "not ok $N # $msg\n"; |
118 | $N++; |
119 | |
120 | print $o->_check_integrity($file, $ENV{INTEGRITY}) |
121 | ? "ok $N\n" : "not ok $N\n"; |
122 | $N++; |
123 | } |
124 | |
125 | sub ctrlfix { |
126 | for (@_) { |
127 | s/\n/\\n/g; |
128 | s/\r/\\r/g; |
129 | } |
130 | } |
131 | |
132 | END { |
133 | undef $o; |
134 | untie @a; |
135 | 1 while unlink $file; |
136 | } |
137 | |