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