1# Before `make install' is performed this script should be runnable with 2# `make test'. After `make install' it should work as `perl test.pl' 3 4######################### We start with some black magic to print on failure. 5 6# Change 1..1 below to 1..last_test_to_print . 7# (It may become useful if the test is moved to ./t subdirectory.) 8 9BEGIN { $| = 1; print "1..86\n"; } 10END {print "not ok 1\n" unless $loaded;} 11use Text::Balanced qw ( :ALL ); 12$loaded = 1; 13print "ok 1\n"; 14$count=2; 15use vars qw( $DEBUG ); 16sub debug { print "\t>>>",@_ if $DEBUG } 17 18######################### End of black magic. 19 20sub expect 21{ 22 local $^W; 23 my ($l1, $l2) = @_; 24 25 if (@$l1 != @$l2) 26 { 27 print "\@l1: ", join(", ", @$l1), "\n"; 28 print "\@l2: ", join(", ", @$l2), "\n"; 29 print "not "; 30 } 31 else 32 { 33 for (my $i = 0; $i < @$l1; $i++) 34 { 35 if ($l1->[$i] ne $l2->[$i]) 36 { 37 print "field $i: '$l1->[$i]' ne '$l2->[$i]'\n"; 38 print "not "; 39 last; 40 } 41 } 42 } 43 44 print "ok $count\n"; 45 $count++; 46} 47 48sub divide 49{ 50 my ($text, @index) = @_; 51 my @bits = (); 52 unshift @index, 0; 53 push @index, length($text); 54 for ( my $i= 0; $i < $#index; $i++) 55 { 56 push @bits, substr($text, $index[$i], $index[$i+1]-$index[$i]); 57 } 58 pop @bits; 59 return @bits; 60 61} 62 63 64$stdtext1 = q{$var = do {"val" && $val;};}; 65 66# TESTS 2-4 67$text = $stdtext1; 68expect [ extract_multiple($text,undef,1) ], 69 [ divide $stdtext1 => 4 ]; 70 71expect [ pos $text], [ 4 ]; 72expect [ $text ], [ $stdtext1 ]; 73 74# TESTS 5-7 75$text = $stdtext1; 76expect [ scalar extract_multiple($text,undef,1) ], 77 [ divide $stdtext1 => 4 ]; 78 79expect [ pos $text], [ 0 ]; 80expect [ $text ], [ substr($stdtext1,4) ]; 81 82 83# TESTS 8-10 84$text = $stdtext1; 85expect [ extract_multiple($text,undef,2) ], 86 [ divide($stdtext1 => 4, 10) ]; 87 88expect [ pos $text], [ 10 ]; 89expect [ $text ], [ $stdtext1 ]; 90 91# TESTS 11-13 92$text = $stdtext1; 93expect [ eval{local$^W;scalar extract_multiple($text,undef,2)} ], 94 [ substr($stdtext1,0,4) ]; 95 96expect [ pos $text], [ 0 ]; 97expect [ $text ], [ substr($stdtext1,4) ]; 98 99 100# TESTS 14-16 101$text = $stdtext1; 102expect [ extract_multiple($text,undef,3) ], 103 [ divide($stdtext1 => 4, 10, 26) ]; 104 105expect [ pos $text], [ 26 ]; 106expect [ $text ], [ $stdtext1 ]; 107 108# TESTS 17-19 109$text = $stdtext1; 110expect [ eval{local$^W;scalar extract_multiple($text,undef,3)} ], 111 [ substr($stdtext1,0,4) ]; 112 113expect [ pos $text], [ 0 ]; 114expect [ $text ], [ substr($stdtext1,4) ]; 115 116 117# TESTS 20-22 118$text = $stdtext1; 119expect [ extract_multiple($text,undef,4) ], 120 [ divide($stdtext1 => 4, 10, 26, 27) ]; 121 122expect [ pos $text], [ 27 ]; 123expect [ $text ], [ $stdtext1 ]; 124 125# TESTS 23-25 126$text = $stdtext1; 127expect [ eval{local$^W;scalar extract_multiple($text,undef,4)} ], 128 [ substr($stdtext1,0,4) ]; 129 130expect [ pos $text], [ 0 ]; 131expect [ $text ], [ substr($stdtext1,4) ]; 132 133 134# TESTS 26-28 135$text = $stdtext1; 136expect [ extract_multiple($text,undef,5) ], 137 [ divide($stdtext1 => 4, 10, 26, 27) ]; 138 139expect [ pos $text], [ 27 ]; 140expect [ $text ], [ $stdtext1 ]; 141 142 143# TESTS 29-31 144$text = $stdtext1; 145expect [ eval{local$^W;scalar extract_multiple($text,undef,5)} ], 146 [ substr($stdtext1,0,4) ]; 147 148expect [ pos $text], [ 0 ]; 149expect [ $text ], [ substr($stdtext1,4) ]; 150 151 152 153# TESTS 32-34 154$stdtext2 = q{$var = "val" && (1,2,3);}; 155 156$text = $stdtext2; 157expect [ extract_multiple($text) ], 158 [ divide($stdtext2 => 4, 7, 12, 24) ]; 159 160expect [ pos $text], [ 24 ]; 161expect [ $text ], [ $stdtext2 ]; 162 163# TESTS 35-37 164$text = $stdtext2; 165expect [ scalar extract_multiple($text) ], 166 [ substr($stdtext2,0,4) ]; 167 168expect [ pos $text], [ 0 ]; 169expect [ $text ], [ substr($stdtext2,4) ]; 170 171 172# TESTS 38-40 173$text = $stdtext2; 174expect [ extract_multiple($text,[\&extract_bracketed]) ], 175 [ substr($stdtext2,0,16), substr($stdtext2,16,7), substr($stdtext2,23) ]; 176 177expect [ pos $text], [ 24 ]; 178expect [ $text ], [ $stdtext2 ]; 179 180# TESTS 41-43 181$text = $stdtext2; 182expect [ scalar extract_multiple($text,[\&extract_bracketed]) ], 183 [ substr($stdtext2,0,16) ]; 184 185expect [ pos $text], [ 0 ]; 186expect [ $text ], [ substr($stdtext2,15) ]; 187 188 189# TESTS 44-46 190$text = $stdtext2; 191expect [ extract_multiple($text,[\&extract_variable]) ], 192 [ substr($stdtext2,0,4), substr($stdtext2,4) ]; 193 194expect [ pos $text], [ length($text) ]; 195expect [ $text ], [ $stdtext2 ]; 196 197# TESTS 47-49 198$text = $stdtext2; 199expect [ scalar extract_multiple($text,[\&extract_variable]) ], 200 [ substr($stdtext2,0,4) ]; 201 202expect [ pos $text], [ 0 ]; 203expect [ $text ], [ substr($stdtext2,4) ]; 204 205 206# TESTS 50-52 207$text = $stdtext2; 208expect [ extract_multiple($text,[\&extract_quotelike]) ], 209 [ substr($stdtext2,0,7), substr($stdtext2,7,5), substr($stdtext2,12) ]; 210 211expect [ pos $text], [ length($text) ]; 212expect [ $text ], [ $stdtext2 ]; 213 214# TESTS 53-55 215$text = $stdtext2; 216expect [ scalar extract_multiple($text,[\&extract_quotelike]) ], 217 [ substr($stdtext2,0,7) ]; 218 219expect [ pos $text], [ 0 ]; 220expect [ $text ], [ substr($stdtext2,6) ]; 221 222 223# TESTS 56-58 224$text = $stdtext2; 225expect [ extract_multiple($text,[\&extract_quotelike],2,1) ], 226 [ substr($stdtext2,7,5) ]; 227 228expect [ pos $text], [ 23 ]; 229expect [ $text ], [ $stdtext2 ]; 230 231# TESTS 59-61 232$text = $stdtext2; 233expect [ eval{local$^W;scalar extract_multiple($text,[\&extract_quotelike],2,1)} ], 234 [ substr($stdtext2,7,5) ]; 235 236expect [ pos $text], [ 6 ]; 237expect [ $text ], [ substr($stdtext2,0,6). substr($stdtext2,12) ]; 238 239 240# TESTS 62-64 241$text = $stdtext2; 242expect [ extract_multiple($text,[\&extract_quotelike],1,1) ], 243 [ substr($stdtext2,7,5) ]; 244 245expect [ pos $text], [ 12 ]; 246expect [ $text ], [ $stdtext2 ]; 247 248# TESTS 65-67 249$text = $stdtext2; 250expect [ scalar extract_multiple($text,[\&extract_quotelike],1,1) ], 251 [ substr($stdtext2,7,5) ]; 252 253expect [ pos $text], [ 6 ]; 254expect [ $text ], [ substr($stdtext2,0,6). substr($stdtext2,12) ]; 255 256# TESTS 68-70 257my $stdtext3 = "a,b,c"; 258 259$_ = $stdtext3; 260expect [ extract_multiple(undef, [ sub { /\G[a-z]/gc && $& } ]) ], 261 [ divide($stdtext3 => 1,2,3,4,5) ]; 262 263expect [ pos ], [ 5 ]; 264expect [ $_ ], [ $stdtext3 ]; 265 266# TESTS 71-73 267 268$_ = $stdtext3; 269expect [ scalar extract_multiple(undef, [ sub { /\G[a-z]/gc && $& } ]) ], 270 [ divide($stdtext3 => 1) ]; 271 272expect [ pos ], [ 0 ]; 273expect [ $_ ], [ substr($stdtext3,1) ]; 274 275 276# TESTS 74-76 277 278$_ = $stdtext3; 279expect [ extract_multiple(undef, [ qr/\G[a-z]/ ]) ], 280 [ divide($stdtext3 => 1,2,3,4,5) ]; 281 282expect [ pos ], [ 5 ]; 283expect [ $_ ], [ $stdtext3 ]; 284 285# TESTS 77-79 286 287$_ = $stdtext3; 288expect [ scalar extract_multiple(undef, [ qr/\G[a-z]/ ]) ], 289 [ divide($stdtext3 => 1) ]; 290 291expect [ pos ], [ 0 ]; 292expect [ $_ ], [ substr($stdtext3,1) ]; 293 294 295# TESTS 80-82 296 297$_ = $stdtext3; 298expect [ extract_multiple(undef, [ q/([a-z]),?/ ]) ], 299 [ qw(a b c) ]; 300 301expect [ pos ], [ 5 ]; 302expect [ $_ ], [ $stdtext3 ]; 303 304# TESTS 83-85 305 306$_ = $stdtext3; 307expect [ scalar extract_multiple(undef, [ q/([a-z]),?/ ]) ], 308 [ divide($stdtext3 => 1) ]; 309 310expect [ pos ], [ 0 ]; 311expect [ $_ ], [ substr($stdtext3,2) ]; 312 313 314# TEST 86 315 316# Fails in Text-Balanced-1.95 with result ['1 ', '""', '1234'] 317$_ = q{ ""1234}; 318expect [ extract_multiple(undef, [\&extract_quotelike]) ], 319 [ ' ', '""', '1234' ]; 320