This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Upgrade to Text-Balanced-1.98
[perl5.git] / lib / Text / Balanced / t / extmul.t
CommitLineData
a7602084
JH
1BEGIN {
2 if ($ENV{PERL_CORE}) {
3 chdir('t') if -d 't';
4 @INC = qw(../lib);
5 }
6}
7
3270c621
JH
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
49c03c89 16BEGIN { $| = 1; print "1..85\n"; }
3270c621
JH
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]) ],
a7602084 182 [ substr($stdtext2,0,16), substr($stdtext2,16,7), substr($stdtext2,23) ];
3270c621
JH
183
184expect [ pos $text], [ 24 ];
185expect [ $text ], [ $stdtext2 ];
186
187# TESTS 41-43
188$text = $stdtext2;
189expect [ scalar extract_multiple($text,[\&extract_bracketed]) ],
a7602084 190 [ substr($stdtext2,0,16) ];
3270c621
JH
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]) ],
a7602084 216 [ substr($stdtext2,0,7), substr($stdtext2,7,5), substr($stdtext2,12) ];
3270c621
JH
217
218expect [ pos $text], [ length($text) ];
219expect [ $text ], [ $stdtext2 ];
220
221# TESTS 53-55
222$text = $stdtext2;
223expect [ scalar extract_multiple($text,[\&extract_quotelike]) ],
a7602084 224 [ substr($stdtext2,0,7) ];
3270c621
JH
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) ];