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