Commit | Line | Data |
b5aed31e |
1 | #!/usr/bin/perl |
2 | |
3 | my $file = "tf$$.txt"; |
4 | |
fa408a35 |
5 | print "1..56\n"; |
b5aed31e |
6 | |
7 | my $N = 1; |
8 | use Tie::File; |
9 | print "ok $N\n"; $N++; |
10 | |
11 | my $o = tie @a, 'Tie::File', $file; |
12 | print $o ? "ok $N\n" : "not ok $N\n"; |
13 | $N++; |
14 | |
fa408a35 |
15 | # 3-5 create |
b5aed31e |
16 | $a[0] = 'rec0'; |
17 | check_contents("rec0"); |
18 | |
fa408a35 |
19 | # 6-11 append |
b5aed31e |
20 | $a[1] = 'rec1'; |
21 | check_contents("rec0", "rec1"); |
22 | $a[2] = 'rec2'; |
23 | check_contents("rec0", "rec1", "rec2"); |
24 | |
fa408a35 |
25 | # 12-20 same-length alterations |
b5aed31e |
26 | $a[0] = 'new0'; |
27 | check_contents("new0", "rec1", "rec2"); |
28 | $a[1] = 'new1'; |
29 | check_contents("new0", "new1", "rec2"); |
30 | $a[2] = 'new2'; |
31 | check_contents("new0", "new1", "new2"); |
32 | |
fa408a35 |
33 | # 21-35 lengthening alterations |
b5aed31e |
34 | $a[0] = 'long0'; |
35 | check_contents("long0", "new1", "new2"); |
36 | $a[1] = 'long1'; |
37 | check_contents("long0", "long1", "new2"); |
38 | $a[2] = 'long2'; |
39 | check_contents("long0", "long1", "long2"); |
40 | $a[1] = 'longer1'; |
41 | check_contents("long0", "longer1", "long2"); |
42 | $a[0] = 'longer0'; |
43 | check_contents("longer0", "longer1", "long2"); |
44 | |
fa408a35 |
45 | # 36-50 shortening alterations, including truncation |
b5aed31e |
46 | $a[0] = 'short0'; |
47 | check_contents("short0", "longer1", "long2"); |
48 | $a[1] = 'short1'; |
49 | check_contents("short0", "short1", "long2"); |
50 | $a[2] = 'short2'; |
51 | check_contents("short0", "short1", "short2"); |
52 | $a[1] = 'sh1'; |
53 | check_contents("short0", "sh1", "short2"); |
54 | $a[0] = 'sh0'; |
55 | check_contents("sh0", "sh1", "short2"); |
56 | |
fa408a35 |
57 | # (51-56) file with holes |
b5aed31e |
58 | $a[4] = 'rec4'; |
59 | check_contents("sh0", "sh1", "short2", "", "rec4"); |
60 | $a[3] = 'rec3'; |
61 | check_contents("sh0", "sh1", "short2", "rec3", "rec4"); |
62 | |
63 | |
64 | # try inserting a record into the middle of an empty file |
65 | |
7b6b3db1 |
66 | use POSIX 'SEEK_SET'; |
b5aed31e |
67 | sub check_contents { |
68 | my @c = @_; |
69 | my $x = join $/, @c, ''; |
7b6b3db1 |
70 | local *FH = $o->{fh}; |
71 | seek FH, 0, SEEK_SET; |
72 | # my $open = open FH, "< $file"; |
b5aed31e |
73 | my $a; |
74 | { local $/; $a = <FH> } |
7b6b3db1 |
75 | $a = "" unless defined $a; |
76 | if ($a eq $x) { |
77 | print "ok $N\n"; |
78 | } else { |
79 | s{$/}{\\n}g for $a, $x; |
80 | print "not ok $N\n# expected <$x>, got <$a>\n"; |
81 | } |
b5aed31e |
82 | $N++; |
83 | |
84 | # now check FETCH: |
85 | my $good = 1; |
7b6b3db1 |
86 | my $msg; |
b5aed31e |
87 | for (0.. $#c) { |
7b6b3db1 |
88 | unless ($a[$_] eq "$c[$_]$/") { |
89 | $msg = "expected $c[$_]$/, got $a[$_]"; |
90 | $msg =~ s{$/}{\\n}g; |
91 | $good = 0; |
92 | } |
b5aed31e |
93 | } |
7b6b3db1 |
94 | print $good ? "ok $N\n" : "not ok $N # $msg\n"; |
b5aed31e |
95 | $N++; |
fa408a35 |
96 | |
97 | print $o->_check_integrity($file, $ENV{INTEGRITY}) |
98 | ? "ok $N\n" : "not ok $N\n"; |
99 | $N++; |
b5aed31e |
100 | } |
101 | |
102 | END { |
7b6b3db1 |
103 | undef $o; |
104 | untie @a; |
b5aed31e |
105 | 1 while unlink $file; |
106 | } |
107 | |