t/cmd/for.t

   1 #!./perl
   2
   3 print "1..78\n";
   4
   5 for ($i = 0; $i <= 10; $i++) {
   6     $x[$i] = $i;
   7 }
   8 $y = $x[10];
   9 print "#1       :$y: eq :10:\n";
  10 $y = join(' ', @x);
  11 print "#1       :$y: eq :0 1 2 3 4 5 6 7 8 9 10:\n";
  12 if (join(' ', @x) eq '0 1 2 3 4 5 6 7 8 9 10') {
  13         print "ok 1\n";
  14 } else {
  15         print "not ok 1\n";
  16 }
  17
  18 $i = $c = 0;
  19 for (;;) {
  20         $c++;
  21         last if $i++ > 10;
  22 }
  23 if ($c == 12) {print "ok 2\n";} else {print "not ok 2\n";}
  24
  25 $foo = 3210;
  26 @ary = (1,2,3,4,5);
  27 foreach $foo (@ary) {
  28         $foo *= 2;
  29 }
  30 if (join('',@ary) eq '246810') {print "ok 3\n";} else {print "not ok 3\n";}
  31
  32 for (@ary) {
  33     s/(.*)/ok $1\n/;
  34 }
  35
  36 print $ary[1];
  37
  38 # test for internal scratch array generation
  39 # this also tests that $foo was restored to 3210 after test 3
  40 for (split(' ','a b c d e')) {
  41         $foo .= $_;
  42 }
  43 if ($foo eq '3210abcde') {print "ok 5\n";} else {print "not ok 5 $foo\n";}
  44
  45 foreach $foo (("ok 6\n","ok 7\n")) {
  46         print $foo;
  47 }
  48
  49 sub foo {
  50     for $i (1..5) {
  51         return $i if $_[0] == $i;
  52     }
  53 }
  54
  55 print foo(1) == 1 ? "ok" : "not ok", " 8\n";
  56 print foo(2) == 2 ? "ok" : "not ok", " 9\n";
  57 print foo(5) == 5 ? "ok" : "not ok", " 10\n";
  58
  59 sub bar {
  60     return (1, 2, 4);
  61 }
  62
  63 $a = 0;
  64 foreach $b (bar()) {
  65     $a += $b;
  66 }
  67 print $a == 7 ? "ok" : "not ok", " 11\n";
  68
  69 $loop_count = 0;
  70 for ("-3" .. "0") {
  71     $loop_count++;
  72 }
  73 print $loop_count == 4 ? "ok" : "not ok", " 12\n";
  74
  75 # modifying arrays in loops is a no-no
  76 @a = (3,4);
  77 eval { @a = () for (1,2,@a) };
  78 print $@ =~ /Use of freed value in iteration/ ? "ok" : "not ok", " 13\n";
  79
  80 # [perl #30061] double destory when same iterator variable (eg $_) used in
  81 # DESTROY as used in for loop that triggered the destroy
  82
  83 {
  84
  85     my $x = 0;
  86     sub X::DESTROY {
  87         my $o = shift;
  88         $x++;
  89         1 for (1);
  90     }
  91
  92     my %h;
  93     $h{foo} = bless [], 'X';
  94     delete $h{foo} for $h{foo}, 1;
  95     print $x == 1 ? "ok" : "not ok", " 14 - double destroy, x=$x\n";
  96 }
  97
  98 # A lot of tests to check that reversed for works.
  99 my $test = 14;
 100 sub is {
 101     my ($got, $expected, $name) = @_;
 102     ++$test;
 103     if ($got eq $expected) {
 104         print "ok $test # $name\n";
 105         return 1;
 106     }
 107     print "not ok $test # $name\n";
 108     print "# got '$got', expected '$expected'\n";
 109     return 0;
 110 }
 111
 112 @array = ('A', 'B', 'C');
 113 for (@array) {
 114     $r .= $_;
 115 }
 116 is ($r, 'ABC', 'Forwards for array');
 117 $r = '';
 118 for (1,2,3) {
 119     $r .= $_;
 120 }
 121 is ($r, '123', 'Forwards for list');
 122 $r = '';
 123 for (map {$_} @array) {
 124     $r .= $_;
 125 }
 126 is ($r, 'ABC', 'Forwards for array via map');
 127 $r = '';
 128 for (map {$_} 1,2,3) {
 129     $r .= $_;
 130 }
 131 is ($r, '123', 'Forwards for list via map');
 132
 133 $r = '';
 134 for (reverse @array) {
 135     $r .= $_;
 136 }
 137 is ($r, 'CBA', 'Reverse for array');
 138 $r = '';
 139 for (reverse 1,2,3) {
 140     $r .= $_;
 141 }
 142 is ($r, '321', 'Reverse for list');
 143 $r = '';
 144 for (reverse map {$_} @array) {
 145     $r .= $_;
 146 }
 147 is ($r, 'CBA', 'Reverse for array via map');
 148 $r = '';
 149 for (reverse map {$_} 1,2,3) {
 150     $r .= $_;
 151 }
 152 is ($r, '321', 'Reverse for list via map');
 153
 154 $r = '';
 155 for my $i (@array) {
 156     $r .= $i;
 157 }
 158 is ($r, 'ABC', 'Forwards for array with var');
 159 $r = '';
 160 for my $i (1,2,3) {
 161     $r .= $i;
 162 }
 163 is ($r, '123', 'Forwards for list with var');
 164 $r = '';
 165 for my $i (map {$_} @array) {
 166     $r .= $i;
 167 }
 168 is ($r, 'ABC', 'Forwards for array via map with var');
 169 $r = '';
 170 for my $i (map {$_} 1,2,3) {
 171     $r .= $i;
 172 }
 173 is ($r, '123', 'Forwards for list via map with var');
 174
 175 $r = '';
 176 for my $i (reverse @array) {
 177     $r .= $i;
 178 }
 179 is ($r, 'CBA', 'Reverse for array with var');
 180 $r = '';
 181 for my $i (reverse 1,2,3) {
 182     $r .= $i;
 183 }
 184 is ($r, '321', 'Reverse for list with var');
 185 $r = '';
 186 for my $i (reverse map {$_} @array) {
 187     $r .= $i;
 188 }
 189 is ($r, 'CBA', 'Reverse for array via map with var');
 190 $r = '';
 191 for my $i (reverse map {$_} 1,2,3) {
 192     $r .= $i;
 193 }
 194 is ($r, '321', 'Reverse for list via map with var');
 195
 196 # For some reason the generate optree is different when $_ is implicit.
 197 $r = '';
 198 for $_ (@array) {
 199     $r .= $_;
 200 }
 201 is ($r, 'ABC', 'Forwards for array with explicit $_');
 202 $r = '';
 203 for $_ (1,2,3) {
 204     $r .= $_;
 205 }
 206 is ($r, '123', 'Forwards for list with explicit $_');
 207 $r = '';
 208 for $_ (map {$_} @array) {
 209     $r .= $_;
 210 }
 211 is ($r, 'ABC', 'Forwards for array via map with explicit $_');
 212 $r = '';
 213 for $_ (map {$_} 1,2,3) {
 214     $r .= $_;
 215 }
 216 is ($r, '123', 'Forwards for list via map with explicit $_');
 217
 218 $r = '';
 219 for $_ (reverse @array) {
 220     $r .= $_;
 221 }
 222 is ($r, 'CBA', 'Reverse for array with explicit $_');
 223 $r = '';
 224 for $_ (reverse 1,2,3) {
 225     $r .= $_;
 226 }
 227 is ($r, '321', 'Reverse for list with explicit $_');
 228 $r = '';
 229 for $_ (reverse map {$_} @array) {
 230     $r .= $_;
 231 }
 232 is ($r, 'CBA', 'Reverse for array via map with explicit $_');
 233 $r = '';
 234 for $_ (reverse map {$_} 1,2,3) {
 235     $r .= $_;
 236 }
 237 is ($r, '321', 'Reverse for list via map with explicit $_');
 238
 239 # I don't think that my is that different from our in the optree. But test a
 240 # few:
 241 $r = '';
 242 for our $i (reverse @array) {
 243     $r .= $i;
 244 }
 245 is ($r, 'CBA', 'Reverse for array with our var');
 246 $r = '';
 247 for our $i (reverse 1,2,3) {
 248     $r .= $i;
 249 }
 250 is ($r, '321', 'Reverse for list with our var');
 251 $r = '';
 252 for our $i (reverse map {$_} @array) {
 253     $r .= $i;
 254 }
 255 is ($r, 'CBA', 'Reverse for array via map with our var');
 256 $r = '';
 257 for our $i (reverse map {$_} 1,2,3) {
 258     $r .= $i;
 259 }
 260 is ($r, '321', 'Reverse for list via map with our var');
 261
 262
 263 $r = '';
 264 for (1, reverse @array) {
 265     $r .= $_;
 266 }
 267 is ($r, '1CBA', 'Reverse for array with leading value');
 268 $r = '';
 269 for ('A', reverse 1,2,3) {
 270     $r .= $_;
 271 }
 272 is ($r, 'A321', 'Reverse for list with leading value');
 273 $r = '';
 274 for (1, reverse map {$_} @array) {
 275     $r .= $_;
 276 }
 277 is ($r, '1CBA', 'Reverse for array via map with leading value');
 278 $r = '';
 279 for ('A', reverse map {$_} 1,2,3) {
 280     $r .= $_;
 281 }
 282 is ($r, 'A321', 'Reverse for list via map with leading value');
 283
 284 $r = '';
 285 for (reverse (@array), 1) {
 286     $r .= $_;
 287 }
 288 is ($r, 'CBA1', 'Reverse for array with trailing value');
 289 $r = '';
 290 for (reverse (1,2,3), 'A') {
 291     $r .= $_;
 292 }
 293 is ($r, '321A', 'Reverse for list with trailing value');
 294 $r = '';
 295 for (reverse (map {$_} @array), 1) {
 296     $r .= $_;
 297 }
 298 is ($r, 'CBA1', 'Reverse for array via map with trailing value');
 299 $r = '';
 300 for (reverse (map {$_} 1,2,3), 'A') {
 301     $r .= $_;
 302 }
 303 is ($r, '321A', 'Reverse for list via map with trailing value');
 304
 305
 306 $r = '';
 307 for $_ (1, reverse @array) {
 308     $r .= $_;
 309 }
 310 is ($r, '1CBA', 'Reverse for array with leading value with explicit $_');
 311 $r = '';
 312 for $_ ('A', reverse 1,2,3) {
 313     $r .= $_;
 314 }
 315 is ($r, 'A321', 'Reverse for list with leading value with explicit $_');
 316 $r = '';
 317 for $_ (1, reverse map {$_} @array) {
 318     $r .= $_;
 319 }
 320 is ($r, '1CBA',
 321     'Reverse for array via map with leading value with explicit $_');
 322 $r = '';
 323 for $_ ('A', reverse map {$_} 1,2,3) {
 324     $r .= $_;
 325 }
 326 is ($r, 'A321', 'Reverse for list via map with leading value with explicit $_');
 327
 328 $r = '';
 329 for $_ (reverse (@array), 1) {
 330     $r .= $_;
 331 }
 332 is ($r, 'CBA1', 'Reverse for array with trailing value with explicit $_');
 333 $r = '';
 334 for $_ (reverse (1,2,3), 'A') {
 335     $r .= $_;
 336 }
 337 is ($r, '321A', 'Reverse for list with trailing value with explicit $_');
 338 $r = '';
 339 for $_ (reverse (map {$_} @array), 1) {
 340     $r .= $_;
 341 }
 342 is ($r, 'CBA1',
 343     'Reverse for array via map with trailing value with explicit $_');
 344 $r = '';
 345 for $_ (reverse (map {$_} 1,2,3), 'A') {
 346     $r .= $_;
 347 }
 348 is ($r, '321A',
 349     'Reverse for list via map with trailing value with explicit $_');
 350
 351 $r = '';
 352 for my $i (1, reverse @array) {
 353     $r .= $i;
 354 }
 355 is ($r, '1CBA', 'Reverse for array with leading value and var');
 356 $r = '';
 357 for my $i ('A', reverse 1,2,3) {
 358     $r .= $i;
 359 }
 360 is ($r, 'A321', 'Reverse for list with leading value and var');
 361 $r = '';
 362 for my $i (1, reverse map {$_} @array) {
 363     $r .= $i;
 364 }
 365 is ($r, '1CBA', 'Reverse for array via map with leading value and var');
 366 $r = '';
 367 for my $i ('A', reverse map {$_} 1,2,3) {
 368     $r .= $i;
 369 }
 370 is ($r, 'A321', 'Reverse for list via map with leading value and var');
 371
 372 $r = '';
 373 for my $i (reverse (@array), 1) {
 374     $r .= $i;
 375 }
 376 is ($r, 'CBA1', 'Reverse for array with trailing value and var');
 377 $r = '';
 378 for my $i (reverse (1,2,3), 'A') {
 379     $r .= $i;
 380 }
 381 is ($r, '321A', 'Reverse for list with trailing value and var');
 382 $r = '';
 383 for my $i (reverse (map {$_} @array), 1) {
 384     $r .= $i;
 385 }
 386 is ($r, 'CBA1', 'Reverse for array via map with trailing value and var');
 387 $r = '';
 388 for my $i (reverse (map {$_} 1,2,3), 'A') {
 389     $r .= $i;
 390 }
 391 is ($r, '321A', 'Reverse for list via map with trailing value and var');
 392
 393
 394 $r = '';
 395 for (reverse 1, @array) {
 396     $r .= $_;
 397 }
 398 is ($r, 'CBA1', 'Reverse for value and array');
 399 $r = '';
 400 for (reverse map {$_} 1, @array) {
 401     $r .= $_;
 402 }
 403 is ($r, 'CBA1', 'Reverse for value and array via map');
 404
 405 $r = '';
 406 for (reverse (@array, 1)) {
 407     $r .= $_;
 408 }
 409 is ($r, '1CBA', 'Reverse for array and value');
 410 $r = '';
 411 for (reverse (map {$_} @array, 1)) {
 412     $r .= $_;
 413 }
 414 is ($r, '1CBA', 'Reverse for array and value via map');
 415
 416 $r = '';
 417 for $_ (reverse 1, @array) {
 418     $r .= $_;
 419 }
 420 is ($r, 'CBA1', 'Reverse for value and array with explicit $_');
 421 $r = '';
 422 for $_ (reverse map {$_} 1, @array) {
 423     $r .= $_;
 424 }
 425 is ($r, 'CBA1', 'Reverse for value and array via map with explicit $_');
 426
 427 $r = '';
 428 for $_ (reverse (@array, 1)) {
 429     $r .= $_;
 430 }
 431 is ($r, '1CBA', 'Reverse for array and value with explicit $_');
 432 $r = '';
 433 for $_ (reverse (map {$_} @array, 1)) {
 434     $r .= $_;
 435 }
 436 is ($r, '1CBA', 'Reverse for array and value via map with explicit $_');
 437
 438
 439 $r = '';
 440 for my $i (reverse 1, @array) {
 441     $r .= $i;
 442 }
 443 is ($r, 'CBA1', 'Reverse for value and array with var');
 444 $r = '';
 445 for my $i (reverse map {$_} 1, @array) {
 446     $r .= $i;
 447 }
 448 is ($r, 'CBA1', 'Reverse for value and array via map with var');
 449
 450 $r = '';
 451 for my $i (reverse (@array, 1)) {
 452     $r .= $i;
 453 }
 454 is ($r, '1CBA', 'Reverse for array and value with var');
 455 $r = '';
 456 for my $i (reverse (map {$_} @array, 1)) {
 457     $r .= $i;
 458 }
 459 is ($r, '1CBA', 'Reverse for array and value via map with var');