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'
11 ######################### We start with some black magic to print on failure.
13 # Change 1..1 below to 1..last_test_to_print .
14 # (It may become useful if the test is moved to ./t subdirectory.)
16 BEGIN { $| = 1; print "1..85\n"; }
17 END {print "not ok 1\n" unless $loaded;}
18 use Text::Balanced qw ( :ALL );
22 use vars qw( $DEBUG );
23 sub debug { print "\t>>>",@_ if $DEBUG }
25 ######################### End of black magic.
34 print "\@l1: ", join(", ", @$l1), "\n";
35 print "\@l2: ", join(", ", @$l2), "\n";
40 for (my $i = 0; $i < @$l1; $i++)
42 if ($l1->[$i] ne $l2->[$i])
44 print "field $i: '$l1->[$i]' ne '$l2->[$i]'\n";
57 my ($text, @index) = @_;
60 push @index, length($text);
61 for ( my $i= 0; $i < $#index; $i++)
63 push @bits, substr($text, $index[$i], $index[$i+1]-$index[$i]);
71 $stdtext1 = q{$var = do {"val" && $val;};};
75 expect [ extract_multiple($text,undef,1) ],
76 [ divide $stdtext1 => 4 ];
78 expect [ pos $text], [ 4 ];
79 expect [ $text ], [ $stdtext1 ];
83 expect [ scalar extract_multiple($text,undef,1) ],
84 [ divide $stdtext1 => 4 ];
86 expect [ pos $text], [ 0 ];
87 expect [ $text ], [ substr($stdtext1,4) ];
92 expect [ extract_multiple($text,undef,2) ],
93 [ divide($stdtext1 => 4, 10) ];
95 expect [ pos $text], [ 10 ];
96 expect [ $text ], [ $stdtext1 ];
100 expect [ eval{local$^W;scalar extract_multiple($text,undef,2)} ],
101 [ substr($stdtext1,0,4) ];
103 expect [ pos $text], [ 0 ];
104 expect [ $text ], [ substr($stdtext1,4) ];
109 expect [ extract_multiple($text,undef,3) ],
110 [ divide($stdtext1 => 4, 10, 26) ];
112 expect [ pos $text], [ 26 ];
113 expect [ $text ], [ $stdtext1 ];
117 expect [ eval{local$^W;scalar extract_multiple($text,undef,3)} ],
118 [ substr($stdtext1,0,4) ];
120 expect [ pos $text], [ 0 ];
121 expect [ $text ], [ substr($stdtext1,4) ];
126 expect [ extract_multiple($text,undef,4) ],
127 [ divide($stdtext1 => 4, 10, 26, 27) ];
129 expect [ pos $text], [ 27 ];
130 expect [ $text ], [ $stdtext1 ];
134 expect [ eval{local$^W;scalar extract_multiple($text,undef,4)} ],
135 [ substr($stdtext1,0,4) ];
137 expect [ pos $text], [ 0 ];
138 expect [ $text ], [ substr($stdtext1,4) ];
143 expect [ extract_multiple($text,undef,5) ],
144 [ divide($stdtext1 => 4, 10, 26, 27) ];
146 expect [ pos $text], [ 27 ];
147 expect [ $text ], [ $stdtext1 ];
152 expect [ eval{local$^W;scalar extract_multiple($text,undef,5)} ],
153 [ substr($stdtext1,0,4) ];
155 expect [ pos $text], [ 0 ];
156 expect [ $text ], [ substr($stdtext1,4) ];
161 $stdtext2 = q{$var = "val" && (1,2,3);};
164 expect [ extract_multiple($text) ],
165 [ divide($stdtext2 => 4, 7, 12, 24) ];
167 expect [ pos $text], [ 24 ];
168 expect [ $text ], [ $stdtext2 ];
172 expect [ scalar extract_multiple($text) ],
173 [ substr($stdtext2,0,4) ];
175 expect [ pos $text], [ 0 ];
176 expect [ $text ], [ substr($stdtext2,4) ];
181 expect [ extract_multiple($text,[\&extract_bracketed]) ],
182 [ substr($stdtext2,0,16), substr($stdtext2,16,7), substr($stdtext2,23) ];
184 expect [ pos $text], [ 24 ];
185 expect [ $text ], [ $stdtext2 ];
189 expect [ scalar extract_multiple($text,[\&extract_bracketed]) ],
190 [ substr($stdtext2,0,16) ];
192 expect [ pos $text], [ 0 ];
193 expect [ $text ], [ substr($stdtext2,15) ];
198 expect [ extract_multiple($text,[\&extract_variable]) ],
199 [ substr($stdtext2,0,4), substr($stdtext2,4) ];
201 expect [ pos $text], [ length($text) ];
202 expect [ $text ], [ $stdtext2 ];
206 expect [ scalar extract_multiple($text,[\&extract_variable]) ],
207 [ substr($stdtext2,0,4) ];
209 expect [ pos $text], [ 0 ];
210 expect [ $text ], [ substr($stdtext2,4) ];
215 expect [ extract_multiple($text,[\&extract_quotelike]) ],
216 [ substr($stdtext2,0,7), substr($stdtext2,7,5), substr($stdtext2,12) ];
218 expect [ pos $text], [ length($text) ];
219 expect [ $text ], [ $stdtext2 ];
223 expect [ scalar extract_multiple($text,[\&extract_quotelike]) ],
224 [ substr($stdtext2,0,7) ];
226 expect [ pos $text], [ 0 ];
227 expect [ $text ], [ substr($stdtext2,6) ];
232 expect [ extract_multiple($text,[\&extract_quotelike],2,1) ],
233 [ substr($stdtext2,7,5) ];
235 expect [ pos $text], [ 23 ];
236 expect [ $text ], [ $stdtext2 ];
240 expect [ eval{local$^W;scalar extract_multiple($text,[\&extract_quotelike],2,1)} ],
241 [ substr($stdtext2,7,5) ];
243 expect [ pos $text], [ 6 ];
244 expect [ $text ], [ substr($stdtext2,0,6). substr($stdtext2,12) ];
249 expect [ extract_multiple($text,[\&extract_quotelike],1,1) ],
250 [ substr($stdtext2,7,5) ];
252 expect [ pos $text], [ 12 ];
253 expect [ $text ], [ $stdtext2 ];
257 expect [ scalar extract_multiple($text,[\&extract_quotelike],1,1) ],
258 [ substr($stdtext2,7,5) ];
260 expect [ pos $text], [ 6 ];
261 expect [ $text ], [ substr($stdtext2,0,6). substr($stdtext2,12) ];
264 my $stdtext3 = "a,b,c";
267 expect [ extract_multiple(undef, [ sub { /\G[a-z]/gc && $& } ]) ],
268 [ divide($stdtext3 => 1,2,3,4,5) ];
270 expect [ pos ], [ 5 ];
271 expect [ $_ ], [ $stdtext3 ];
276 expect [ scalar extract_multiple(undef, [ sub { /\G[a-z]/gc && $& } ]) ],
277 [ divide($stdtext3 => 1) ];
279 expect [ pos ], [ 0 ];
280 expect [ $_ ], [ substr($stdtext3,1) ];
286 expect [ extract_multiple(undef, [ qr/\G[a-z]/ ]) ],
287 [ divide($stdtext3 => 1,2,3,4,5) ];
289 expect [ pos ], [ 5 ];
290 expect [ $_ ], [ $stdtext3 ];
295 expect [ scalar extract_multiple(undef, [ qr/\G[a-z]/ ]) ],
296 [ divide($stdtext3 => 1) ];
298 expect [ pos ], [ 0 ];
299 expect [ $_ ], [ substr($stdtext3,1) ];
305 expect [ extract_multiple(undef, [ q/([a-z]),?/ ]) ],
308 expect [ pos ], [ 5 ];
309 expect [ $_ ], [ $stdtext3 ];
314 expect [ scalar extract_multiple(undef, [ q/([a-z]),?/ ]) ],
315 [ divide($stdtext3 => 1) ];
317 expect [ pos ], [ 0 ];
318 expect [ $_ ], [ substr($stdtext3,2) ];