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