This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
34207df2f3df96a2337795c1db877a35e822eb23
[perl5.git] / lib / Text / Balanced / t / extmul.t
1 BEGIN {
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
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]) ],
182         [ substr($stdtext2,0,16), substr($stdtext2,16,7), substr($stdtext2,23) ];
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]) ],
190         [ substr($stdtext2,0,16) ];
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]) ],
216         [ substr($stdtext2,0,7), substr($stdtext2,7,5), substr($stdtext2,12) ];
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]) ],
224         [ substr($stdtext2,0,7) ];
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) ];