Commit | Line | Data |
b5aed31e |
1 | #!/usr/bin/perl |
2 | |
3 | my $file = "tf$$.txt"; |
4 | |
6fc0ea7e |
5 | print "1..47\n"; |
b5aed31e |
6 | |
7 | my $N = 1; |
8 | use Tie::File; |
9 | print "ok $N\n"; $N++; |
10 | |
6fc0ea7e |
11 | $RECSEP = 'blah'; |
12 | my $o = tie @a, 'Tie::File', $file, |
13 | recsep => $RECSEP, autochomp => 0, autodefer => 0; |
b5aed31e |
14 | print $o ? "ok $N\n" : "not ok $N\n"; |
15 | $N++; |
16 | |
17 | |
18 | # 3-4 create |
19 | $a[0] = 'rec0'; |
20 | check_contents("rec0"); |
21 | |
22 | # 5-8 append |
23 | $a[1] = 'rec1'; |
24 | check_contents("rec0", "rec1"); |
25 | $a[2] = 'rec2'; |
26 | check_contents("rec0", "rec1", "rec2"); |
27 | |
28 | # 9-14 same-length alterations |
29 | $a[0] = 'new0'; |
30 | check_contents("new0", "rec1", "rec2"); |
31 | $a[1] = 'new1'; |
32 | check_contents("new0", "new1", "rec2"); |
33 | $a[2] = 'new2'; |
34 | check_contents("new0", "new1", "new2"); |
35 | |
36 | # 15-24 lengthening alterations |
37 | $a[0] = 'long0'; |
38 | check_contents("long0", "new1", "new2"); |
39 | $a[1] = 'long1'; |
40 | check_contents("long0", "long1", "new2"); |
41 | $a[2] = 'long2'; |
42 | check_contents("long0", "long1", "long2"); |
43 | $a[1] = 'longer1'; |
44 | check_contents("long0", "longer1", "long2"); |
45 | $a[0] = 'longer0'; |
46 | check_contents("longer0", "longer1", "long2"); |
47 | |
48 | # 25-34 shortening alterations, including truncation |
49 | $a[0] = 'short0'; |
50 | check_contents("short0", "longer1", "long2"); |
51 | $a[1] = 'short1'; |
52 | check_contents("short0", "short1", "long2"); |
53 | $a[2] = 'short2'; |
54 | check_contents("short0", "short1", "short2"); |
55 | $a[1] = 'sh1'; |
56 | check_contents("short0", "sh1", "short2"); |
57 | $a[0] = 'sh0'; |
58 | check_contents("sh0", "sh1", "short2"); |
59 | |
60 | # file with holes |
61 | $a[4] = 'rec4'; |
62 | check_contents("sh0", "sh1", "short2", "", "rec4"); |
63 | $a[3] = 'rec3'; |
64 | check_contents("sh0", "sh1", "short2", "rec3", "rec4"); |
65 | |
6fc0ea7e |
66 | # (35-37) zero out file |
67 | @a = (); |
68 | check_contents(); |
69 | |
70 | # (38-40) insert into the middle of an empty file |
71 | $a[3] = "rec3"; |
72 | check_contents("", "", "", "rec3"); |
73 | |
74 | |
75 | # (41-46) 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. Yup, there is, |
77 | # and adding the appropriate defined() test fixes the problem. |
78 | undef $o; untie @a; 1 while unlink $file; |
79 | $RECSEP = '0'; |
80 | $o = tie @a, 'Tie::File', $file, |
81 | recsep => $RECSEP, autochomp => 0, autodefer => 0; |
82 | print $o ? "ok $N\n" : "not ok $N\n"; |
83 | $N++; |
84 | $#a = 2; |
85 | my $z = $a[1]; # caches "0" |
86 | $a[2] = "oops"; |
87 | check_contents("", "", "oops"); |
88 | $a[1] = "bah"; |
89 | check_contents("", "bah", "oops"); |
b5aed31e |
90 | |
b5aed31e |
91 | |
7b6b3db1 |
92 | use POSIX 'SEEK_SET'; |
b5aed31e |
93 | sub check_contents { |
94 | my @c = @_; |
6fc0ea7e |
95 | my $x = join $RECSEP, @c, ''; |
7b6b3db1 |
96 | local *FH = $o->{fh}; |
97 | seek FH, 0, SEEK_SET; |
b5aed31e |
98 | my $a; |
99 | { local $/; $a = <FH> } |
7b6b3db1 |
100 | |
101 | $a = "" unless defined $a; |
102 | if ($a eq $x) { |
103 | print "ok $N\n"; |
104 | } else { |
b3fe5a4c |
105 | my $msg = "# expected <$x>, got <$a>"; |
106 | ctrlfix($msg); |
107 | print "not ok $N $msg\n"; |
7b6b3db1 |
108 | } |
b5aed31e |
109 | $N++; |
110 | |
111 | # now check FETCH: |
112 | my $good = 1; |
113 | for (0.. $#c) { |
6fc0ea7e |
114 | unless ($a[$_] eq "$c[$_]$RECSEP") { |
115 | $msg = "expected $c[$_]$RECSEP, got $a[$_]"; |
b3fe5a4c |
116 | ctrlfix($msg); |
7b6b3db1 |
117 | $good = 0; |
118 | } |
b5aed31e |
119 | } |
6fc0ea7e |
120 | print $good ? "ok $N\n" : "not ok $N # fetch $msg\n"; |
b5aed31e |
121 | $N++; |
122 | } |
123 | |
b3fe5a4c |
124 | |
125 | sub ctrlfix { |
126 | for (@_) { |
127 | s/\n/\\n/g; |
128 | s/\r/\\r/g; |
129 | } |
130 | } |
131 | |
132 | |
b5aed31e |
133 | END { |
7b6b3db1 |
134 | undef $o; |
135 | untie @a; |
b5aed31e |
136 | 1 while unlink $file; |
137 | } |
138 | |