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