Commit | Line | Data |
---|---|---|
b5aed31e AMS |
1 | #!/usr/bin/perl |
2 | # | |
3 | # Check SPLICE function's return value | |
4 | # (04_splice.t checks its effect on the file) | |
5 | # | |
6 | ||
7 | my $file = "tf$$.txt"; | |
8 | my $data = "rec0$/rec1$/rec2$/"; | |
9 | ||
10 | print "1..45\n"; | |
11 | ||
12 | my $N = 1; | |
13 | use Tie::File; | |
14 | print "ok $N\n"; $N++; # partial credit just for showing up | |
15 | ||
16 | my $o = tie @a, 'Tie::File', $file; | |
17 | print $o ? "ok $N\n" : "not ok $N\n"; | |
18 | $N++; | |
19 | ||
20 | my $n; | |
21 | ||
22 | # (3-12) splicing at the beginning | |
23 | init_file($data); | |
24 | ||
25 | @r = splice(@a, 0, 0, "rec4"); | |
26 | check_result(); | |
27 | @r = splice(@a, 0, 1, "rec5"); # same length | |
28 | check_result("rec4"); | |
29 | @r = splice(@a, 0, 1, "record5"); # longer | |
30 | check_result("rec5"); | |
31 | ||
32 | @r = splice(@a, 0, 1, "r5"); # shorter | |
33 | check_result("record5"); | |
34 | @r = splice(@a, 0, 1); # removal | |
35 | check_result("r5"); | |
36 | @r = splice(@a, 0, 0); # no-op | |
37 | check_result(); | |
38 | @r = splice(@a, 0, 0, 'r7', 'rec8'); # insert more than one | |
39 | check_result(); | |
40 | @r = splice(@a, 0, 2, 'rec7', 'record8', 'rec9'); # insert more than delete | |
41 | check_result('r7', 'rec8'); | |
42 | ||
43 | @r = splice(@a, 0, 3, 'record9', 'rec10'); # delete more than insert | |
44 | check_result('rec7', 'record8', 'rec9'); | |
45 | @r = splice(@a, 0, 2); # delete more than one | |
46 | check_result('record9', 'rec10'); | |
47 | ||
48 | ||
49 | # (13-22) splicing in the middle | |
50 | @r = splice(@a, 1, 0, "rec4"); | |
51 | check_result(); | |
52 | @r = splice(@a, 1, 1, "rec5"); # same length | |
53 | check_result('rec4'); | |
54 | @r = splice(@a, 1, 1, "record5"); # longer | |
55 | check_result('rec5'); | |
56 | ||
57 | @r = splice(@a, 1, 1, "r5"); # shorter | |
58 | check_result("record5"); | |
59 | @r = splice(@a, 1, 1); # removal | |
60 | check_result("r5"); | |
61 | @r = splice(@a, 1, 0); # no-op | |
62 | check_result(); | |
63 | @r = splice(@a, 1, 0, 'r7', 'rec8'); # insert more than one | |
64 | check_result(); | |
65 | @r = splice(@a, 1, 2, 'rec7', 'record8', 'rec9'); # insert more than delete | |
66 | check_result('r7', 'rec8'); | |
67 | ||
68 | @r = splice(@a, 1, 3, 'record9', 'rec10'); # delete more than insert | |
69 | check_result('rec7', 'record8', 'rec9'); | |
70 | @r = splice(@a, 1, 2); # delete more than one | |
71 | check_result('record9','rec10'); | |
72 | ||
73 | # (23-32) splicing at the end | |
74 | @r = splice(@a, 3, 0, "rec4"); | |
75 | check_result(); | |
76 | @r = splice(@a, 3, 1, "rec5"); # same length | |
77 | check_result('rec4'); | |
78 | @r = splice(@a, 3, 1, "record5"); # longer | |
79 | check_result('rec5'); | |
80 | ||
81 | @r = splice(@a, 3, 1, "r5"); # shorter | |
82 | check_result('record5'); | |
83 | @r = splice(@a, 3, 1); # removal | |
84 | check_result('r5'); | |
85 | @r = splice(@a, 3, 0); # no-op | |
86 | check_result(); | |
87 | @r = splice(@a, 3, 0, 'r7', 'rec8'); # insert more than one | |
88 | check_result(); | |
89 | @r = splice(@a, 3, 2, 'rec7', 'record8', 'rec9'); # insert more than delete | |
90 | check_result('r7', 'rec8'); | |
91 | ||
92 | @r = splice(@a, 3, 3, 'record9', 'rec10'); # delete more than insert | |
93 | check_result('rec7', 'record8', 'rec9'); | |
94 | @r = splice(@a, 3, 2); # delete more than one | |
95 | check_result('record9', 'rec10'); | |
96 | ||
97 | # (33-42) splicing with negative subscript | |
98 | @r = splice(@a, -1, 0, "rec4"); | |
99 | check_result(); | |
100 | @r = splice(@a, -1, 1, "rec5"); # same length | |
101 | check_result('rec2'); | |
102 | @r = splice(@a, -1, 1, "record5"); # longer | |
103 | check_result("rec5"); | |
104 | ||
105 | @r = splice(@a, -1, 1, "r5"); # shorter | |
106 | check_result("record5"); | |
107 | @r = splice(@a, -1, 1); # removal | |
108 | check_result("r5"); | |
109 | @r = splice(@a, -1, 0); # no-op | |
110 | check_result(); | |
111 | @r = splice(@a, -1, 0, 'r7', 'rec8'); # insert more than one | |
112 | check_result(); | |
113 | @r = splice(@a, -1, 2, 'rec7', 'record8', 'rec9'); # insert more than delete | |
114 | check_result('rec4'); | |
115 | ||
116 | @r = splice(@a, -3, 3, 'record9', 'rec10'); # delete more than insert | |
117 | check_result('rec7', 'record8', 'rec9'); | |
118 | @r = splice(@a, -4, 3); # delete more than one | |
119 | check_result('r7', 'rec8', 'record9'); | |
120 | ||
121 | # (43) scrub it all out | |
122 | @r = splice(@a, 0, 3); | |
123 | check_result('rec0', 'rec1', 'rec10'); | |
124 | ||
125 | # (44) put some back in | |
126 | @r = splice(@a, 0, 0, "rec0", "rec1"); | |
127 | check_result(); | |
128 | ||
129 | # (45) what if we remove too many records? | |
130 | @r = splice(@a, 0, 17); | |
131 | check_result('rec0', 'rec1'); | |
132 | ||
133 | sub init_file { | |
134 | my $data = shift; | |
135 | open F, "> $file" or die $!; | |
1768807e | 136 | binmode F; |
b5aed31e AMS |
137 | print F $data; |
138 | close F; | |
139 | } | |
140 | ||
141 | # actual results are in @r. | |
142 | # expected results are in @_ | |
143 | sub check_result { | |
144 | my @x = @_; | |
145 | chomp @r; | |
146 | my $good = 1; | |
147 | $good = 0 unless @r == @x; | |
148 | for my $i (0 .. $#r) { | |
149 | $good = 0 unless $r[$i] eq $x[$i]; | |
150 | } | |
151 | print $good ? "ok $N\n" : "not ok $N \# was (@r); should be (@x)\n"; | |
152 | $N++; | |
153 | } | |
154 | ||
155 | END { | |
156 | 1 while unlink $file; | |
157 | } | |
158 |