Commit | Line | Data |
3270c621 |
1 | BEGIN { |
2 | chdir 't' if -d 't'; |
3 | @INC = '../lib'; |
4 | } |
5 | |
6 | # Before `make install' is performed this script should be runnable with |
7 | # `make test'. After `make install' it should work as `perl test.pl' |
8 | |
9 | ######################### We start with some black magic to print on failure. |
10 | |
11 | # Change 1..1 below to 1..last_test_to_print . |
12 | # (It may become useful if the test is moved to ./t subdirectory.) |
13 | |
14 | BEGIN { $| = 1; print "1..85\n"; } |
15 | END {print "not ok 1\n" unless $loaded;} |
16 | use Text::Balanced qw ( :ALL ); |
17 | $loaded = 1; |
18 | print "ok 1\n"; |
19 | $count=2; |
20 | use vars qw( $DEBUG ); |
21 | sub debug { print "\t>>>",@_ if $DEBUG } |
22 | |
23 | ######################### End of black magic. |
24 | |
25 | sub expect |
26 | { |
27 | local $^W; |
28 | my ($l1, $l2) = @_; |
29 | |
30 | if (@$l1 != @$l2) |
31 | { |
32 | print "\@l1: ", join(", ", @$l1), "\n"; |
33 | print "\@l2: ", join(", ", @$l2), "\n"; |
34 | print "not "; |
35 | } |
36 | else |
37 | { |
38 | for (my $i = 0; $i < @$l1; $i++) |
39 | { |
40 | if ($l1->[$i] ne $l2->[$i]) |
41 | { |
42 | print "field $i: '$l1->[$i]' ne '$l2->[$i]'\n"; |
43 | print "not "; |
44 | last; |
45 | } |
46 | } |
47 | } |
48 | |
49 | print "ok $count\n"; |
50 | $count++; |
51 | } |
52 | |
53 | sub divide |
54 | { |
55 | my ($text, @index) = @_; |
56 | my @bits = (); |
57 | unshift @index, 0; |
58 | push @index, length($text); |
59 | for ( my $i= 0; $i < $#index; $i++) |
60 | { |
61 | push @bits, substr($text, $index[$i], $index[$i+1]-$index[$i]); |
62 | } |
63 | pop @bits; |
64 | return @bits; |
65 | |
66 | } |
67 | |
68 | |
69 | $stdtext1 = q{$var = do {"val" && $val;};}; |
70 | |
71 | # TESTS 2-4 |
72 | $text = $stdtext1; |
73 | expect [ extract_multiple($text,undef,1) ], |
74 | [ divide $stdtext1 => 4 ]; |
75 | |
76 | expect [ pos $text], [ 4 ]; |
77 | expect [ $text ], [ $stdtext1 ]; |
78 | |
79 | # TESTS 5-7 |
80 | $text = $stdtext1; |
81 | expect [ scalar extract_multiple($text,undef,1) ], |
82 | [ divide $stdtext1 => 4 ]; |
83 | |
84 | expect [ pos $text], [ 0 ]; |
85 | expect [ $text ], [ substr($stdtext1,4) ]; |
86 | |
87 | |
88 | # TESTS 8-10 |
89 | $text = $stdtext1; |
90 | expect [ extract_multiple($text,undef,2) ], |
91 | [ divide($stdtext1 => 4, 10) ]; |
92 | |
93 | expect [ pos $text], [ 10 ]; |
94 | expect [ $text ], [ $stdtext1 ]; |
95 | |
96 | # TESTS 11-13 |
97 | $text = $stdtext1; |
98 | expect [ eval{local$^W;scalar extract_multiple($text,undef,2)} ], |
99 | [ substr($stdtext1,0,4) ]; |
100 | |
101 | expect [ pos $text], [ 0 ]; |
102 | expect [ $text ], [ substr($stdtext1,4) ]; |
103 | |
104 | |
105 | # TESTS 14-16 |
106 | $text = $stdtext1; |
107 | expect [ extract_multiple($text,undef,3) ], |
108 | [ divide($stdtext1 => 4, 10, 26) ]; |
109 | |
110 | expect [ pos $text], [ 26 ]; |
111 | expect [ $text ], [ $stdtext1 ]; |
112 | |
113 | # TESTS 17-19 |
114 | $text = $stdtext1; |
115 | expect [ eval{local$^W;scalar extract_multiple($text,undef,3)} ], |
116 | [ substr($stdtext1,0,4) ]; |
117 | |
118 | expect [ pos $text], [ 0 ]; |
119 | expect [ $text ], [ substr($stdtext1,4) ]; |
120 | |
121 | |
122 | # TESTS 20-22 |
123 | $text = $stdtext1; |
124 | expect [ extract_multiple($text,undef,4) ], |
125 | [ divide($stdtext1 => 4, 10, 26, 27) ]; |
126 | |
127 | expect [ pos $text], [ 27 ]; |
128 | expect [ $text ], [ $stdtext1 ]; |
129 | |
130 | # TESTS 23-25 |
131 | $text = $stdtext1; |
132 | expect [ eval{local$^W;scalar extract_multiple($text,undef,4)} ], |
133 | [ substr($stdtext1,0,4) ]; |
134 | |
135 | expect [ pos $text], [ 0 ]; |
136 | expect [ $text ], [ substr($stdtext1,4) ]; |
137 | |
138 | |
139 | # TESTS 26-28 |
140 | $text = $stdtext1; |
141 | expect [ extract_multiple($text,undef,5) ], |
142 | [ divide($stdtext1 => 4, 10, 26, 27) ]; |
143 | |
144 | expect [ pos $text], [ 27 ]; |
145 | expect [ $text ], [ $stdtext1 ]; |
146 | |
147 | |
148 | # TESTS 29-31 |
149 | $text = $stdtext1; |
150 | expect [ eval{local$^W;scalar extract_multiple($text,undef,5)} ], |
151 | [ substr($stdtext1,0,4) ]; |
152 | |
153 | expect [ pos $text], [ 0 ]; |
154 | expect [ $text ], [ substr($stdtext1,4) ]; |
155 | |
156 | |
157 | |
158 | # TESTS 32-34 |
159 | $stdtext2 = q{$var = "val" && (1,2,3);}; |
160 | |
161 | $text = $stdtext2; |
162 | expect [ extract_multiple($text) ], |
163 | [ divide($stdtext2 => 4, 7, 12, 24) ]; |
164 | |
165 | expect [ pos $text], [ 24 ]; |
166 | expect [ $text ], [ $stdtext2 ]; |
167 | |
168 | # TESTS 35-37 |
169 | $text = $stdtext2; |
170 | expect [ scalar extract_multiple($text) ], |
171 | [ substr($stdtext2,0,4) ]; |
172 | |
173 | expect [ pos $text], [ 0 ]; |
174 | expect [ $text ], [ substr($stdtext2,4) ]; |
175 | |
176 | |
177 | # TESTS 38-40 |
178 | $text = $stdtext2; |
179 | expect [ extract_multiple($text,[\&extract_bracketed]) ], |
180 | [ substr($stdtext2,0,15), substr($stdtext2,16,7), substr($stdtext2,23) ]; |
181 | |
182 | expect [ pos $text], [ 24 ]; |
183 | expect [ $text ], [ $stdtext2 ]; |
184 | |
185 | # TESTS 41-43 |
186 | $text = $stdtext2; |
187 | expect [ scalar extract_multiple($text,[\&extract_bracketed]) ], |
188 | [ substr($stdtext2,0,15) ]; |
189 | |
190 | expect [ pos $text], [ 0 ]; |
191 | expect [ $text ], [ substr($stdtext2,15) ]; |
192 | |
193 | |
194 | # TESTS 44-46 |
195 | $text = $stdtext2; |
196 | expect [ extract_multiple($text,[\&extract_variable]) ], |
197 | [ substr($stdtext2,0,4), substr($stdtext2,4) ]; |
198 | |
199 | expect [ pos $text], [ length($text) ]; |
200 | expect [ $text ], [ $stdtext2 ]; |
201 | |
202 | # TESTS 47-49 |
203 | $text = $stdtext2; |
204 | expect [ scalar extract_multiple($text,[\&extract_variable]) ], |
205 | [ substr($stdtext2,0,4) ]; |
206 | |
207 | expect [ pos $text], [ 0 ]; |
208 | expect [ $text ], [ substr($stdtext2,4) ]; |
209 | |
210 | |
211 | # TESTS 50-52 |
212 | $text = $stdtext2; |
213 | expect [ extract_multiple($text,[\&extract_quotelike]) ], |
214 | [ substr($stdtext2,0,6), substr($stdtext2,7,5), substr($stdtext2,12) ]; |
215 | |
216 | expect [ pos $text], [ length($text) ]; |
217 | expect [ $text ], [ $stdtext2 ]; |
218 | |
219 | # TESTS 53-55 |
220 | $text = $stdtext2; |
221 | expect [ scalar extract_multiple($text,[\&extract_quotelike]) ], |
222 | [ substr($stdtext2,0,6) ]; |
223 | |
224 | expect [ pos $text], [ 0 ]; |
225 | expect [ $text ], [ substr($stdtext2,6) ]; |
226 | |
227 | |
228 | # TESTS 56-58 |
229 | $text = $stdtext2; |
230 | expect [ extract_multiple($text,[\&extract_quotelike],2,1) ], |
231 | [ substr($stdtext2,7,5) ]; |
232 | |
233 | expect [ pos $text], [ 23 ]; |
234 | expect [ $text ], [ $stdtext2 ]; |
235 | |
236 | # TESTS 59-61 |
237 | $text = $stdtext2; |
238 | expect [ eval{local$^W;scalar extract_multiple($text,[\&extract_quotelike],2,1)} ], |
239 | [ substr($stdtext2,7,5) ]; |
240 | |
241 | expect [ pos $text], [ 6 ]; |
242 | expect [ $text ], [ substr($stdtext2,0,6). substr($stdtext2,12) ]; |
243 | |
244 | |
245 | # TESTS 62-64 |
246 | $text = $stdtext2; |
247 | expect [ extract_multiple($text,[\&extract_quotelike],1,1) ], |
248 | [ substr($stdtext2,7,5) ]; |
249 | |
250 | expect [ pos $text], [ 12 ]; |
251 | expect [ $text ], [ $stdtext2 ]; |
252 | |
253 | # TESTS 65-67 |
254 | $text = $stdtext2; |
255 | expect [ scalar extract_multiple($text,[\&extract_quotelike],1,1) ], |
256 | [ substr($stdtext2,7,5) ]; |
257 | |
258 | expect [ pos $text], [ 6 ]; |
259 | expect [ $text ], [ substr($stdtext2,0,6). substr($stdtext2,12) ]; |
260 | |
261 | # TESTS 68-70 |
262 | my $stdtext3 = "a,b,c"; |
263 | |
264 | $_ = $stdtext3; |
265 | expect [ extract_multiple(undef, [ sub { /\G[a-z]/gc && $& } ]) ], |
266 | [ divide($stdtext3 => 1,2,3,4,5) ]; |
267 | |
268 | expect [ pos ], [ 5 ]; |
269 | expect [ $_ ], [ $stdtext3 ]; |
270 | |
271 | # TESTS 71-73 |
272 | |
273 | $_ = $stdtext3; |
274 | expect [ scalar extract_multiple(undef, [ sub { /\G[a-z]/gc && $& } ]) ], |
275 | [ divide($stdtext3 => 1) ]; |
276 | |
277 | expect [ pos ], [ 0 ]; |
278 | expect [ $_ ], [ substr($stdtext3,1) ]; |
279 | |
280 | |
281 | # TESTS 74-76 |
282 | |
283 | $_ = $stdtext3; |
284 | expect [ extract_multiple(undef, [ qr/\G[a-z]/ ]) ], |
285 | [ divide($stdtext3 => 1,2,3,4,5) ]; |
286 | |
287 | expect [ pos ], [ 5 ]; |
288 | expect [ $_ ], [ $stdtext3 ]; |
289 | |
290 | # TESTS 77-79 |
291 | |
292 | $_ = $stdtext3; |
293 | expect [ scalar extract_multiple(undef, [ qr/\G[a-z]/ ]) ], |
294 | [ divide($stdtext3 => 1) ]; |
295 | |
296 | expect [ pos ], [ 0 ]; |
297 | expect [ $_ ], [ substr($stdtext3,1) ]; |
298 | |
299 | |
300 | # TESTS 80-82 |
301 | |
302 | $_ = $stdtext3; |
303 | expect [ extract_multiple(undef, [ q/([a-z]),?/ ]) ], |
304 | [ qw(a b c) ]; |
305 | |
306 | expect [ pos ], [ 5 ]; |
307 | expect [ $_ ], [ $stdtext3 ]; |
308 | |
309 | # TESTS 83-85 |
310 | |
311 | $_ = $stdtext3; |
312 | expect [ scalar extract_multiple(undef, [ q/([a-z]),?/ ]) ], |
313 | [ divide($stdtext3 => 1) ]; |
314 | |
315 | expect [ pos ], [ 0 ]; |
316 | expect [ $_ ], [ substr($stdtext3,2) ]; |