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