t/cmd/for.t

   1 #!./perl
   2
   3 print "1..118\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 $r = '';
 133 for (1 .. 3) {
 134     $r .= $_;
 135 }
 136 is ($r, '123', 'Forwards for list via ..');
 137 $r = '';
 138 for ('A' .. 'C') {
 139     $r .= $_;
 140 }
 141 is ($r, 'ABC', 'Forwards for list via ..');
 142
 143 $r = '';
 144 for (reverse @array) {
 145     $r .= $_;
 146 }
 147 is ($r, 'CBA', 'Reverse for array');
 148 $r = '';
 149 for (reverse 1,2,3) {
 150     $r .= $_;
 151 }
 152 is ($r, '321', 'Reverse for list');
 153 $r = '';
 154 for (reverse map {$_} @array) {
 155     $r .= $_;
 156 }
 157 is ($r, 'CBA', 'Reverse for array via map');
 158 $r = '';
 159 for (reverse map {$_} 1,2,3) {
 160     $r .= $_;
 161 }
 162 is ($r, '321', 'Reverse for list via map');
 163 $r = '';
 164 for (reverse 1 .. 3) {
 165     $r .= $_;
 166 }
 167 is ($r, '321', 'Reverse for list via ..');
 168 $r = '';
 169 for (reverse 'A' .. 'C') {
 170     $r .= $_;
 171 }
 172 is ($r, 'CBA', 'Reverse for list via ..');
 173
 174 $r = '';
 175 for my $i (@array) {
 176     $r .= $i;
 177 }
 178 is ($r, 'ABC', 'Forwards for array with var');
 179 $r = '';
 180 for my $i (1,2,3) {
 181     $r .= $i;
 182 }
 183 is ($r, '123', 'Forwards for list with var');
 184 $r = '';
 185 for my $i (map {$_} @array) {
 186     $r .= $i;
 187 }
 188 is ($r, 'ABC', 'Forwards for array via map with var');
 189 $r = '';
 190 for my $i (map {$_} 1,2,3) {
 191     $r .= $i;
 192 }
 193 is ($r, '123', 'Forwards for list via map with var');
 194 $r = '';
 195 for my $i (1 .. 3) {
 196     $r .= $i;
 197 }
 198 is ($r, '123', 'Forwards for list via .. with var');
 199 $r = '';
 200 for my $i ('A' .. 'C') {
 201     $r .= $i;
 202 }
 203 is ($r, 'ABC', 'Forwards for list via .. with var');
 204
 205 $r = '';
 206 for my $i (reverse @array) {
 207     $r .= $i;
 208 }
 209 is ($r, 'CBA', 'Reverse for array with var');
 210 $r = '';
 211 for my $i (reverse 1,2,3) {
 212     $r .= $i;
 213 }
 214 is ($r, '321', 'Reverse for list with var');
 215 $r = '';
 216 for my $i (reverse map {$_} @array) {
 217     $r .= $i;
 218 }
 219 is ($r, 'CBA', 'Reverse for array via map with var');
 220 $r = '';
 221 for my $i (reverse map {$_} 1,2,3) {
 222     $r .= $i;
 223 }
 224 is ($r, '321', 'Reverse for list via map with var');
 225 $r = '';
 226 for my $i (reverse 1 .. 3) {
 227     $r .= $i;
 228 }
 229 is ($r, '321', 'Reverse for list via .. with var');
 230 $r = '';
 231 for my $i (reverse 'A' .. 'C') {
 232     $r .= $i;
 233 }
 234 is ($r, 'CBA', 'Reverse for list via .. with var');
 235
 236 # For some reason the generate optree is different when $_ is implicit.
 237 $r = '';
 238 for $_ (@array) {
 239     $r .= $_;
 240 }
 241 is ($r, 'ABC', 'Forwards for array with explicit $_');
 242 $r = '';
 243 for $_ (1,2,3) {
 244     $r .= $_;
 245 }
 246 is ($r, '123', 'Forwards for list with explicit $_');
 247 $r = '';
 248 for $_ (map {$_} @array) {
 249     $r .= $_;
 250 }
 251 is ($r, 'ABC', 'Forwards for array via map with explicit $_');
 252 $r = '';
 253 for $_ (map {$_} 1,2,3) {
 254     $r .= $_;
 255 }
 256 is ($r, '123', 'Forwards for list via map with explicit $_');
 257 $r = '';
 258 for $_ (1 .. 3) {
 259     $r .= $_;
 260 }
 261 is ($r, '123', 'Forwards for list via .. with var with explicit $_');
 262 $r = '';
 263 for $_ ('A' .. 'C') {
 264     $r .= $_;
 265 }
 266 is ($r, 'ABC', 'Forwards for list via .. with var with explicit $_');
 267
 268 $r = '';
 269 for $_ (reverse @array) {
 270     $r .= $_;
 271 }
 272 is ($r, 'CBA', 'Reverse for array with explicit $_');
 273 $r = '';
 274 for $_ (reverse 1,2,3) {
 275     $r .= $_;
 276 }
 277 is ($r, '321', 'Reverse for list with explicit $_');
 278 $r = '';
 279 for $_ (reverse map {$_} @array) {
 280     $r .= $_;
 281 }
 282 is ($r, 'CBA', 'Reverse for array via map with explicit $_');
 283 $r = '';
 284 for $_ (reverse map {$_} 1,2,3) {
 285     $r .= $_;
 286 }
 287 is ($r, '321', 'Reverse for list via map with explicit $_');
 288 $r = '';
 289 for $_ (reverse 1 .. 3) {
 290     $r .= $_;
 291 }
 292 is ($r, '321', 'Reverse for list via .. with var with explicit $_');
 293 $r = '';
 294 for $_ (reverse 'A' .. 'C') {
 295     $r .= $_;
 296 }
 297 is ($r, 'CBA', 'Reverse for list via .. with var with explicit $_');
 298
 299 # I don't think that my is that different from our in the optree. But test a
 300 # few:
 301 $r = '';
 302 for our $i (reverse @array) {
 303     $r .= $i;
 304 }
 305 is ($r, 'CBA', 'Reverse for array with our var');
 306 $r = '';
 307 for our $i (reverse 1,2,3) {
 308     $r .= $i;
 309 }
 310 is ($r, '321', 'Reverse for list with our var');
 311 $r = '';
 312 for our $i (reverse map {$_} @array) {
 313     $r .= $i;
 314 }
 315 is ($r, 'CBA', 'Reverse for array via map with our var');
 316 $r = '';
 317 for our $i (reverse map {$_} 1,2,3) {
 318     $r .= $i;
 319 }
 320 is ($r, '321', 'Reverse for list via map with our var');
 321 $r = '';
 322 for our $i (reverse 1 .. 3) {
 323     $r .= $i;
 324 }
 325 is ($r, '321', 'Reverse for list via .. with our var');
 326 $r = '';
 327 for our $i (reverse 'A' .. 'C') {
 328     $r .= $i;
 329 }
 330 is ($r, 'CBA', 'Reverse for list via .. with our var');
 331
 332
 333 $r = '';
 334 for (1, reverse @array) {
 335     $r .= $_;
 336 }
 337 is ($r, '1CBA', 'Reverse for array with leading value');
 338 $r = '';
 339 for ('A', reverse 1,2,3) {
 340     $r .= $_;
 341 }
 342 is ($r, 'A321', 'Reverse for list with leading value');
 343 $r = '';
 344 for (1, reverse map {$_} @array) {
 345     $r .= $_;
 346 }
 347 is ($r, '1CBA', 'Reverse for array via map with leading value');
 348 $r = '';
 349 for ('A', reverse map {$_} 1,2,3) {
 350     $r .= $_;
 351 }
 352 is ($r, 'A321', 'Reverse for list via map with leading value');
 353 $r = '';
 354 for ('A', reverse 1 .. 3) {
 355     $r .= $_;
 356 }
 357 is ($r, 'A321', 'Reverse for list via .. with leading value');
 358 $r = '';
 359 for (1, reverse 'A' .. 'C') {
 360     $r .= $_;
 361 }
 362 is ($r, '1CBA', 'Reverse for list via .. with leading value');
 363
 364 $r = '';
 365 for (reverse (@array), 1) {
 366     $r .= $_;
 367 }
 368 is ($r, 'CBA1', 'Reverse for array with trailing value');
 369 $r = '';
 370 for (reverse (1,2,3), 'A') {
 371     $r .= $_;
 372 }
 373 is ($r, '321A', 'Reverse for list with trailing value');
 374 $r = '';
 375 for (reverse (map {$_} @array), 1) {
 376     $r .= $_;
 377 }
 378 is ($r, 'CBA1', 'Reverse for array via map with trailing value');
 379 $r = '';
 380 for (reverse (map {$_} 1,2,3), 'A') {
 381     $r .= $_;
 382 }
 383 is ($r, '321A', 'Reverse for list via map with trailing value');
 384 $r = '';
 385 for (reverse (1 .. 3), 'A') {
 386     $r .= $_;
 387 }
 388 is ($r, '321A', 'Reverse for list via .. with trailing value');
 389 $r = '';
 390 for (reverse ('A' .. 'C'), 1) {
 391     $r .= $_;
 392 }
 393 is ($r, 'CBA1', 'Reverse for list via .. with trailing value');
 394
 395
 396 $r = '';
 397 for $_ (1, reverse @array) {
 398     $r .= $_;
 399 }
 400 is ($r, '1CBA', 'Reverse for array with leading value with explicit $_');
 401 $r = '';
 402 for $_ ('A', reverse 1,2,3) {
 403     $r .= $_;
 404 }
 405 is ($r, 'A321', 'Reverse for list with leading value with explicit $_');
 406 $r = '';
 407 for $_ (1, reverse map {$_} @array) {
 408     $r .= $_;
 409 }
 410 is ($r, '1CBA',
 411     'Reverse for array via map with leading value with explicit $_');
 412 $r = '';
 413 for $_ ('A', reverse map {$_} 1,2,3) {
 414     $r .= $_;
 415 }
 416 is ($r, 'A321', 'Reverse for list via map with leading value with explicit $_');
 417 $r = '';
 418 for $_ ('A', reverse 1 .. 3) {
 419     $r .= $_;
 420 }
 421 is ($r, 'A321', 'Reverse for list via .. with leading value with explicit $_');
 422 $r = '';
 423 for $_ (1, reverse 'A' .. 'C') {
 424     $r .= $_;
 425 }
 426 is ($r, '1CBA', 'Reverse for list via .. with leading value with explicit $_');
 427
 428 $r = '';
 429 for $_ (reverse (@array), 1) {
 430     $r .= $_;
 431 }
 432 is ($r, 'CBA1', 'Reverse for array with trailing value with explicit $_');
 433 $r = '';
 434 for $_ (reverse (1,2,3), 'A') {
 435     $r .= $_;
 436 }
 437 is ($r, '321A', 'Reverse for list with trailing value with explicit $_');
 438 $r = '';
 439 for $_ (reverse (map {$_} @array), 1) {
 440     $r .= $_;
 441 }
 442 is ($r, 'CBA1',
 443     'Reverse for array via map with trailing value with explicit $_');
 444 $r = '';
 445 for $_ (reverse (map {$_} 1,2,3), 'A') {
 446     $r .= $_;
 447 }
 448 is ($r, '321A',
 449     'Reverse for list via map with trailing value with explicit $_');
 450 $r = '';
 451 for $_ (reverse (1 .. 3), 'A') {
 452     $r .= $_;
 453 }
 454 is ($r, '321A', 'Reverse for list via .. with trailing value with explicit $_');
 455 $r = '';
 456 for $_ (reverse ('A' .. 'C'), 1) {
 457     $r .= $_;
 458 }
 459 is ($r, 'CBA1', 'Reverse for list via .. with trailing value with explicit $_');
 460
 461 $r = '';
 462 for my $i (1, reverse @array) {
 463     $r .= $i;
 464 }
 465 is ($r, '1CBA', 'Reverse for array with leading value and var');
 466 $r = '';
 467 for my $i ('A', reverse 1,2,3) {
 468     $r .= $i;
 469 }
 470 is ($r, 'A321', 'Reverse for list with leading value and var');
 471 $r = '';
 472 for my $i (1, reverse map {$_} @array) {
 473     $r .= $i;
 474 }
 475 is ($r, '1CBA', 'Reverse for array via map with leading value and var');
 476 $r = '';
 477 for my $i ('A', reverse map {$_} 1,2,3) {
 478     $r .= $i;
 479 }
 480 is ($r, 'A321', 'Reverse for list via map with leading value and var');
 481 $r = '';
 482 for my $i ('A', reverse 1 .. 3) {
 483     $r .= $i;
 484 }
 485 is ($r, 'A321', 'Reverse for list via .. with leading value and var');
 486 $r = '';
 487 for my $i (1, reverse 'A' .. 'C') {
 488     $r .= $i;
 489 }
 490 is ($r, '1CBA', 'Reverse for list via .. with leading value and var');
 491
 492 $r = '';
 493 for my $i (reverse (@array), 1) {
 494     $r .= $i;
 495 }
 496 is ($r, 'CBA1', 'Reverse for array with trailing value and var');
 497 $r = '';
 498 for my $i (reverse (1,2,3), 'A') {
 499     $r .= $i;
 500 }
 501 is ($r, '321A', 'Reverse for list with trailing value and var');
 502 $r = '';
 503 for my $i (reverse (map {$_} @array), 1) {
 504     $r .= $i;
 505 }
 506 is ($r, 'CBA1', 'Reverse for array via map with trailing value and var');
 507 $r = '';
 508 for my $i (reverse (map {$_} 1,2,3), 'A') {
 509     $r .= $i;
 510 }
 511 is ($r, '321A', 'Reverse for list via map with trailing value and var');
 512 $r = '';
 513 for my $i (reverse (1 .. 3), 'A') {
 514     $r .= $i;
 515 }
 516 is ($r, '321A', 'Reverse for list via .. with trailing value and var');
 517 $r = '';
 518 for my $i (reverse ('A' .. 'C'), 1) {
 519     $r .= $i;
 520 }
 521 is ($r, 'CBA1', 'Reverse for list via .. with trailing value and var');
 522
 523
 524 $r = '';
 525 for (reverse 1, @array) {
 526     $r .= $_;
 527 }
 528 is ($r, 'CBA1', 'Reverse for value and array');
 529 $r = '';
 530 for (reverse map {$_} 1, @array) {
 531     $r .= $_;
 532 }
 533 is ($r, 'CBA1', 'Reverse for value and array via map');
 534 $r = '';
 535 for (reverse 1 .. 3, @array) {
 536     $r .= $_;
 537 }
 538 is ($r, 'CBA321', 'Reverse for .. and array');
 539 $r = '';
 540 for (reverse 'X' .. 'Z', @array) {
 541     $r .= $_;
 542 }
 543 is ($r, 'CBAZYX', 'Reverse for .. and array');
 544 $r = '';
 545 for (reverse map {$_} 1 .. 3, @array) {
 546     $r .= $_;
 547 }
 548 is ($r, 'CBA321', 'Reverse for .. and array via map');
 549 $r = '';
 550 for (reverse map {$_} 'X' .. 'Z', @array) {
 551     $r .= $_;
 552 }
 553 is ($r, 'CBAZYX', 'Reverse for .. and array via map');
 554
 555 $r = '';
 556 for (reverse (@array, 1)) {
 557     $r .= $_;
 558 }
 559 is ($r, '1CBA', 'Reverse for array and value');
 560 $r = '';
 561 for (reverse (map {$_} @array, 1)) {
 562     $r .= $_;
 563 }
 564 is ($r, '1CBA', 'Reverse for array and value via map');
 565
 566 $r = '';
 567 for $_ (reverse 1, @array) {
 568     $r .= $_;
 569 }
 570 is ($r, 'CBA1', 'Reverse for value and array with explicit $_');
 571 $r = '';
 572 for $_ (reverse map {$_} 1, @array) {
 573     $r .= $_;
 574 }
 575 is ($r, 'CBA1', 'Reverse for value and array via map with explicit $_');
 576 $r = '';
 577 for $_ (reverse 1 .. 3, @array) {
 578     $r .= $_;
 579 }
 580 is ($r, 'CBA321', 'Reverse for .. and array with explicit $_');
 581 $r = '';
 582 for $_ (reverse 'X' .. 'Z', @array) {
 583     $r .= $_;
 584 }
 585 is ($r, 'CBAZYX', 'Reverse for .. and array with explicit $_');
 586 $r = '';
 587 for $_ (reverse map {$_} 1 .. 3, @array) {
 588     $r .= $_;
 589 }
 590 is ($r, 'CBA321', 'Reverse for .. and array via map with explicit $_');
 591 $r = '';
 592 for $_ (reverse map {$_} 'X' .. 'Z', @array) {
 593     $r .= $_;
 594 }
 595 is ($r, 'CBAZYX', 'Reverse for .. and array via map with explicit $_');
 596
 597 $r = '';
 598 for $_ (reverse (@array, 1)) {
 599     $r .= $_;
 600 }
 601 is ($r, '1CBA', 'Reverse for array and value with explicit $_');
 602 $r = '';
 603 for $_ (reverse (map {$_} @array, 1)) {
 604     $r .= $_;
 605 }
 606 is ($r, '1CBA', 'Reverse for array and value via map with explicit $_');
 607
 608
 609 $r = '';
 610 for my $i (reverse 1, @array) {
 611     $r .= $i;
 612 }
 613 is ($r, 'CBA1', 'Reverse for value and array with var');
 614 $r = '';
 615 for my $i (reverse map {$_} 1, @array) {
 616     $r .= $i;
 617 }
 618 is ($r, 'CBA1', 'Reverse for value and array via map with var');
 619 $r = '';
 620 for my $i (reverse 1 .. 3, @array) {
 621     $r .= $i;
 622 }
 623 is ($r, 'CBA321', 'Reverse for .. and array with var');
 624 $r = '';
 625 for my $i (reverse 'X' .. 'Z', @array) {
 626     $r .= $i;
 627 }
 628 is ($r, 'CBAZYX', 'Reverse for .. and array with var');
 629 $r = '';
 630 for my $i (reverse map {$_} 1 .. 3, @array) {
 631     $r .= $i;
 632 }
 633 is ($r, 'CBA321', 'Reverse for .. and array via map with var');
 634 $r = '';
 635 for my $i (reverse map {$_} 'X' .. 'Z', @array) {
 636     $r .= $i;
 637 }
 638 is ($r, 'CBAZYX', 'Reverse for .. and array via map with var');
 639
 640 $r = '';
 641 for my $i (reverse (@array, 1)) {
 642     $r .= $i;
 643 }
 644 is ($r, '1CBA', 'Reverse for array and value with var');
 645 $r = '';
 646 for my $i (reverse (map {$_} @array, 1)) {
 647     $r .= $i;
 648 }
 649 is ($r, '1CBA', 'Reverse for array and value via map with var');
 650
 651 TODO: {
 652     $test++;
 653     local $TODO = "RT #1085: what should be output of perl -we 'print do { foreach (1, 2) { 1; } }'";
 654     if (do {17; foreach (1, 2) { 1; } } != 17) {
 655         print "not ";
 656     }
 657     print "ok $test # TODO $TODO\n";
 658 }
 659
 660 TODO: {
 661     $test++;
 662     no warnings 'reserved';
 663     local $TODO = "RT #2166: foreach spuriously autovivifies";
 664     my %h;
 665     foreach (@h{a, b}) {}
 666     if(keys(%h)) {
 667         print "not ";
 668     }
 669     print "ok $test # TODO $TODO\n";
 670 }