Commit | Line | Data |
---|---|---|
b5aed31e AMS |
1 | #!/usr/bin/perl |
2 | # | |
3 | # Check SPLICE function's effect on the file | |
4 | # (07_rv_splice.t checks its return value) | |
5 | # | |
6 | # Each call to 'check_contents' actually performs two tests. | |
7 | # First, it calls the tied object's own 'check_integrity' method, | |
8 | # which makes sure that the contents of the read cache and offset tables | |
9 | # accurately reflect the contents of the file. | |
10 | # Then, it checks the actual contents of the file against the expected | |
11 | # contents. | |
12 | ||
13 | my $file = "tf$$.txt"; | |
14 | my $data = "rec0blahrec1blahrec2blah"; | |
15 | ||
16 | print "1..88\n"; | |
17 | ||
18 | my $N = 1; | |
19 | use Tie::File; | |
20 | print "ok $N\n"; $N++; # partial credit just for showing up | |
21 | ||
22 | my $o = tie @a, 'Tie::File', $file, recsep => 'blah'; | |
23 | print $o ? "ok $N\n" : "not ok $N\n"; | |
24 | $N++; | |
25 | ||
26 | my $n; | |
27 | ||
28 | # (3-22) splicing at the beginning | |
29 | init_file($data); | |
30 | ||
31 | splice(@a, 0, 0, "rec4"); | |
32 | check_contents("rec4blah$data"); | |
33 | splice(@a, 0, 1, "rec5"); # same length | |
34 | check_contents("rec5blah$data"); | |
35 | splice(@a, 0, 1, "record5"); # longer | |
36 | check_contents("record5blah$data"); | |
37 | ||
38 | splice(@a, 0, 1, "r5"); # shorter | |
39 | check_contents("r5blah$data"); | |
40 | splice(@a, 0, 1); # removal | |
41 | check_contents("$data"); | |
42 | splice(@a, 0, 0); # no-op | |
43 | check_contents("$data"); | |
44 | splice(@a, 0, 0, 'r7', 'rec8'); # insert more than one | |
45 | check_contents("r7blahrec8blah$data"); | |
46 | splice(@a, 0, 2, 'rec7', 'record8', 'rec9'); # insert more than delete | |
47 | check_contents("rec7blahrecord8blahrec9blah$data"); | |
48 | ||
49 | splice(@a, 0, 3, 'record9', 'rec10'); # delete more than insert | |
50 | check_contents("record9blahrec10blah$data"); | |
51 | splice(@a, 0, 2); # delete more than one | |
52 | check_contents("$data"); | |
53 | ||
54 | ||
55 | # (23-42) splicing in the middle | |
56 | splice(@a, 1, 0, "rec4"); | |
57 | check_contents("rec0blahrec4blahrec1blahrec2blah"); | |
58 | splice(@a, 1, 1, "rec5"); # same length | |
59 | check_contents("rec0blahrec5blahrec1blahrec2blah"); | |
60 | splice(@a, 1, 1, "record5"); # longer | |
61 | check_contents("rec0blahrecord5blahrec1blahrec2blah"); | |
62 | ||
63 | splice(@a, 1, 1, "r5"); # shorter | |
64 | check_contents("rec0blahr5blahrec1blahrec2blah"); | |
65 | splice(@a, 1, 1); # removal | |
66 | check_contents("$data"); | |
67 | splice(@a, 1, 0); # no-op | |
68 | check_contents("$data"); | |
69 | splice(@a, 1, 0, 'r7', 'rec8'); # insert more than one | |
70 | check_contents("rec0blahr7blahrec8blahrec1blahrec2blah"); | |
71 | splice(@a, 1, 2, 'rec7', 'record8', 'rec9'); # insert more than delete | |
72 | check_contents("rec0blahrec7blahrecord8blahrec9blahrec1blahrec2blah"); | |
73 | ||
74 | splice(@a, 1, 3, 'record9', 'rec10'); # delete more than insert | |
75 | check_contents("rec0blahrecord9blahrec10blahrec1blahrec2blah"); | |
76 | splice(@a, 1, 2); # delete more than one | |
77 | check_contents("$data"); | |
78 | ||
79 | # (43-62) splicing at the end | |
80 | splice(@a, 3, 0, "rec4"); | |
81 | check_contents("$ {data}rec4blah"); | |
82 | splice(@a, 3, 1, "rec5"); # same length | |
83 | check_contents("$ {data}rec5blah"); | |
84 | splice(@a, 3, 1, "record5"); # longer | |
85 | check_contents("$ {data}record5blah"); | |
86 | ||
87 | splice(@a, 3, 1, "r5"); # shorter | |
88 | check_contents("$ {data}r5blah"); | |
89 | splice(@a, 3, 1); # removal | |
90 | check_contents("$data"); | |
91 | splice(@a, 3, 0); # no-op | |
92 | check_contents("$data"); | |
93 | splice(@a, 3, 0, 'r7', 'rec8'); # insert more than one | |
94 | check_contents("$ {data}r7blahrec8blah"); | |
95 | splice(@a, 3, 2, 'rec7', 'record8', 'rec9'); # insert more than delete | |
96 | check_contents("$ {data}rec7blahrecord8blahrec9blah"); | |
97 | ||
98 | splice(@a, 3, 3, 'record9', 'rec10'); # delete more than insert | |
99 | check_contents("$ {data}record9blahrec10blah"); | |
100 | splice(@a, 3, 2); # delete more than one | |
101 | check_contents("$data"); | |
102 | ||
103 | # (63-82) splicing with negative subscript | |
104 | splice(@a, -1, 0, "rec4"); | |
105 | check_contents("rec0blahrec1blahrec4blahrec2blah"); | |
106 | splice(@a, -1, 1, "rec5"); # same length | |
107 | check_contents("rec0blahrec1blahrec4blahrec5blah"); | |
108 | splice(@a, -1, 1, "record5"); # longer | |
109 | check_contents("rec0blahrec1blahrec4blahrecord5blah"); | |
110 | ||
111 | splice(@a, -1, 1, "r5"); # shorter | |
112 | check_contents("rec0blahrec1blahrec4blahr5blah"); | |
113 | splice(@a, -1, 1); # removal | |
114 | check_contents("rec0blahrec1blahrec4blah"); | |
115 | splice(@a, -1, 0); # no-op | |
116 | check_contents("rec0blahrec1blahrec4blah"); | |
117 | splice(@a, -1, 0, 'r7', 'rec8'); # insert more than one | |
118 | check_contents("rec0blahrec1blahr7blahrec8blahrec4blah"); | |
119 | splice(@a, -1, 2, 'rec7', 'record8', 'rec9'); # insert more than delete | |
120 | check_contents("rec0blahrec1blahr7blahrec8blahrec7blahrecord8blahrec9blah"); | |
121 | ||
122 | splice(@a, -3, 3, 'record9', 'rec10'); # delete more than insert | |
123 | check_contents("rec0blahrec1blahr7blahrec8blahrecord9blahrec10blah"); | |
124 | splice(@a, -4, 3); # delete more than one | |
125 | check_contents("rec0blahrec1blahrec10blah"); | |
126 | ||
127 | # (83-84) scrub it all out | |
128 | splice(@a, 0, 3); | |
129 | check_contents(""); | |
130 | ||
131 | # (85-86) put some back in | |
132 | splice(@a, 0, 0, "rec0", "rec1"); | |
133 | check_contents("rec0blahrec1blah"); | |
134 | ||
135 | # (87-88) what if we remove too many records? | |
136 | splice(@a, 0, 17); | |
137 | check_contents(""); | |
138 | ||
139 | sub init_file { | |
140 | my $data = shift; | |
141 | open F, "> $file" or die $!; | |
1768807e | 142 | binmode F; |
b5aed31e AMS |
143 | print F $data; |
144 | close F; | |
145 | } | |
146 | ||
147 | sub check_contents { | |
148 | my $x = shift; | |
149 | local *FH; | |
150 | my $integrity = $o->_check_integrity($file, $ENV{INTEGRITY}); | |
151 | print $integrity ? "ok $N\n" : "not ok $N\n"; | |
152 | $N++; | |
153 | my $open = open FH, "< $file"; | |
154 | my $a; | |
155 | { local $/; $a = <FH> } | |
156 | print (($open && $a eq $x) ? "ok $N\n" : "not ok $N\n"); | |
157 | $N++; | |
158 | } | |
159 | ||
160 | END { | |
161 | 1 while unlink $file; | |
162 | } | |
163 |