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