lib/Text/Balanced/t/extmul.t

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