t/lib/tb-xmult.t

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