cpan/Text-Balanced/t/05_extmul.t

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