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'
9 ######################### We start with some black magic to print on failure.
11 # Change 1..1 below to 1..last_test_to_print .
12 # (It may become useful if the test is moved to ./t subdirectory.)
14 BEGIN { $| = 1; print "1..85\n"; }
15 END {print "not ok 1\n" unless $loaded;}
16 use Text::Balanced qw ( :ALL );
20 use vars qw( $DEBUG );
21 sub debug { print "\t>>>",@_ if $DEBUG }
23 ######################### End of black magic.
32 print "\@l1: ", join(", ", @$l1), "\n";
33 print "\@l2: ", join(", ", @$l2), "\n";
38 for (my $i = 0; $i < @$l1; $i++)
40 if ($l1->[$i] ne $l2->[$i])
42 print "field $i: '$l1->[$i]' ne '$l2->[$i]'\n";
55 my ($text, @index) = @_;
58 push @index, length($text);
59 for ( my $i= 0; $i < $#index; $i++)
61 push @bits, substr($text, $index[$i], $index[$i+1]-$index[$i]);
69 $stdtext1 = q{$var = do {"val" && $val;};};
73 expect [ extract_multiple($text,undef,1) ],
74 [ divide $stdtext1 => 4 ];
76 expect [ pos $text], [ 4 ];
77 expect [ $text ], [ $stdtext1 ];
81 expect [ scalar extract_multiple($text,undef,1) ],
82 [ divide $stdtext1 => 4 ];
84 expect [ pos $text], [ 0 ];
85 expect [ $text ], [ substr($stdtext1,4) ];
90 expect [ extract_multiple($text,undef,2) ],
91 [ divide($stdtext1 => 4, 10) ];
93 expect [ pos $text], [ 10 ];
94 expect [ $text ], [ $stdtext1 ];
98 expect [ eval{local$^W;scalar extract_multiple($text,undef,2)} ],
99 [ substr($stdtext1,0,4) ];
101 expect [ pos $text], [ 0 ];
102 expect [ $text ], [ substr($stdtext1,4) ];
107 expect [ extract_multiple($text,undef,3) ],
108 [ divide($stdtext1 => 4, 10, 26) ];
110 expect [ pos $text], [ 26 ];
111 expect [ $text ], [ $stdtext1 ];
115 expect [ eval{local$^W;scalar extract_multiple($text,undef,3)} ],
116 [ substr($stdtext1,0,4) ];
118 expect [ pos $text], [ 0 ];
119 expect [ $text ], [ substr($stdtext1,4) ];
124 expect [ extract_multiple($text,undef,4) ],
125 [ divide($stdtext1 => 4, 10, 26, 27) ];
127 expect [ pos $text], [ 27 ];
128 expect [ $text ], [ $stdtext1 ];
132 expect [ eval{local$^W;scalar extract_multiple($text,undef,4)} ],
133 [ substr($stdtext1,0,4) ];
135 expect [ pos $text], [ 0 ];
136 expect [ $text ], [ substr($stdtext1,4) ];
141 expect [ extract_multiple($text,undef,5) ],
142 [ divide($stdtext1 => 4, 10, 26, 27) ];
144 expect [ pos $text], [ 27 ];
145 expect [ $text ], [ $stdtext1 ];
150 expect [ eval{local$^W;scalar extract_multiple($text,undef,5)} ],
151 [ substr($stdtext1,0,4) ];
153 expect [ pos $text], [ 0 ];
154 expect [ $text ], [ substr($stdtext1,4) ];
159 $stdtext2 = q{$var = "val" && (1,2,3);};
162 expect [ extract_multiple($text) ],
163 [ divide($stdtext2 => 4, 7, 12, 24) ];
165 expect [ pos $text], [ 24 ];
166 expect [ $text ], [ $stdtext2 ];
170 expect [ scalar extract_multiple($text) ],
171 [ substr($stdtext2,0,4) ];
173 expect [ pos $text], [ 0 ];
174 expect [ $text ], [ substr($stdtext2,4) ];
179 expect [ extract_multiple($text,[\&extract_bracketed]) ],
180 [ substr($stdtext2,0,15), substr($stdtext2,16,7), substr($stdtext2,23) ];
182 expect [ pos $text], [ 24 ];
183 expect [ $text ], [ $stdtext2 ];
187 expect [ scalar extract_multiple($text,[\&extract_bracketed]) ],
188 [ substr($stdtext2,0,15) ];
190 expect [ pos $text], [ 0 ];
191 expect [ $text ], [ substr($stdtext2,15) ];
196 expect [ extract_multiple($text,[\&extract_variable]) ],
197 [ substr($stdtext2,0,4), substr($stdtext2,4) ];
199 expect [ pos $text], [ length($text) ];
200 expect [ $text ], [ $stdtext2 ];
204 expect [ scalar extract_multiple($text,[\&extract_variable]) ],
205 [ substr($stdtext2,0,4) ];
207 expect [ pos $text], [ 0 ];
208 expect [ $text ], [ substr($stdtext2,4) ];
213 expect [ extract_multiple($text,[\&extract_quotelike]) ],
214 [ substr($stdtext2,0,6), substr($stdtext2,7,5), substr($stdtext2,12) ];
216 expect [ pos $text], [ length($text) ];
217 expect [ $text ], [ $stdtext2 ];
221 expect [ scalar extract_multiple($text,[\&extract_quotelike]) ],
222 [ substr($stdtext2,0,6) ];
224 expect [ pos $text], [ 0 ];
225 expect [ $text ], [ substr($stdtext2,6) ];
230 expect [ extract_multiple($text,[\&extract_quotelike],2,1) ],
231 [ substr($stdtext2,7,5) ];
233 expect [ pos $text], [ 23 ];
234 expect [ $text ], [ $stdtext2 ];
238 expect [ eval{local$^W;scalar extract_multiple($text,[\&extract_quotelike],2,1)} ],
239 [ substr($stdtext2,7,5) ];
241 expect [ pos $text], [ 6 ];
242 expect [ $text ], [ substr($stdtext2,0,6). substr($stdtext2,12) ];
247 expect [ extract_multiple($text,[\&extract_quotelike],1,1) ],
248 [ substr($stdtext2,7,5) ];
250 expect [ pos $text], [ 12 ];
251 expect [ $text ], [ $stdtext2 ];
255 expect [ scalar extract_multiple($text,[\&extract_quotelike],1,1) ],
256 [ substr($stdtext2,7,5) ];
258 expect [ pos $text], [ 6 ];
259 expect [ $text ], [ substr($stdtext2,0,6). substr($stdtext2,12) ];
262 my $stdtext3 = "a,b,c";
265 expect [ extract_multiple(undef, [ sub { /\G[a-z]/gc && $& } ]) ],
266 [ divide($stdtext3 => 1,2,3,4,5) ];
268 expect [ pos ], [ 5 ];
269 expect [ $_ ], [ $stdtext3 ];
274 expect [ scalar extract_multiple(undef, [ sub { /\G[a-z]/gc && $& } ]) ],
275 [ divide($stdtext3 => 1) ];
277 expect [ pos ], [ 0 ];
278 expect [ $_ ], [ substr($stdtext3,1) ];
284 expect [ extract_multiple(undef, [ qr/\G[a-z]/ ]) ],
285 [ divide($stdtext3 => 1,2,3,4,5) ];
287 expect [ pos ], [ 5 ];
288 expect [ $_ ], [ $stdtext3 ];
293 expect [ scalar extract_multiple(undef, [ qr/\G[a-z]/ ]) ],
294 [ divide($stdtext3 => 1) ];
296 expect [ pos ], [ 0 ];
297 expect [ $_ ], [ substr($stdtext3,1) ];
303 expect [ extract_multiple(undef, [ q/([a-z]),?/ ]) ],
306 expect [ pos ], [ 5 ];
307 expect [ $_ ], [ $stdtext3 ];
312 expect [ scalar extract_multiple(undef, [ q/([a-z]),?/ ]) ],
313 [ divide($stdtext3 => 1) ];
315 expect [ pos ], [ 0 ];
316 expect [ $_ ], [ substr($stdtext3,2) ];