t/op/for.t

   1 #!./perl
   2
   3 BEGIN {
   4     chdir 't' if -d 't';
   5     require "./test.pl";
   6 }
   7
   8 plan(124);
   9
  10 # A lot of tests to check that reversed for works.
  11
  12 @array = ('A', 'B', 'C');
  13 for (@array) {
  14     $r .= $_;
  15 }
  16 is ($r, 'ABC', 'Forwards for array');
  17 $r = '';
  18 for (1,2,3) {
  19     $r .= $_;
  20 }
  21 is ($r, '123', 'Forwards for list');
  22 $r = '';
  23 for (map {$_} @array) {
  24     $r .= $_;
  25 }
  26 is ($r, 'ABC', 'Forwards for array via map');
  27 $r = '';
  28 for (map {$_} 1,2,3) {
  29     $r .= $_;
  30 }
  31 is ($r, '123', 'Forwards for list via map');
  32 $r = '';
  33 for (1 .. 3) {
  34     $r .= $_;
  35 }
  36 is ($r, '123', 'Forwards for list via ..');
  37 $r = '';
  38 for ('A' .. 'C') {
  39     $r .= $_;
  40 }
  41 is ($r, 'ABC', 'Forwards for list via ..');
  42
  43 $r = '';
  44 for (reverse @array) {
  45     $r .= $_;
  46 }
  47 is ($r, 'CBA', 'Reverse for array');
  48 $r = '';
  49 for (reverse 1,2,3) {
  50     $r .= $_;
  51 }
  52 is ($r, '321', 'Reverse for list');
  53 $r = '';
  54 for (reverse map {$_} @array) {
  55     $r .= $_;
  56 }
  57 is ($r, 'CBA', 'Reverse for array via map');
  58 $r = '';
  59 for (reverse map {$_} 1,2,3) {
  60     $r .= $_;
  61 }
  62 is ($r, '321', 'Reverse for list via map');
  63 $r = '';
  64 for (reverse 1 .. 3) {
  65     $r .= $_;
  66 }
  67 is ($r, '321', 'Reverse for list via ..');
  68 $r = '';
  69 for (reverse 'A' .. 'C') {
  70     $r .= $_;
  71 }
  72 is ($r, 'CBA', 'Reverse for list via ..');
  73
  74 $r = '';
  75 for my $i (@array) {
  76     $r .= $i;
  77 }
  78 is ($r, 'ABC', 'Forwards for array with var');
  79 $r = '';
  80 for my $i (1,2,3) {
  81     $r .= $i;
  82 }
  83 is ($r, '123', 'Forwards for list with var');
  84 $r = '';
  85 for my $i (map {$_} @array) {
  86     $r .= $i;
  87 }
  88 is ($r, 'ABC', 'Forwards for array via map with var');
  89 $r = '';
  90 for my $i (map {$_} 1,2,3) {
  91     $r .= $i;
  92 }
  93 is ($r, '123', 'Forwards for list via map with var');
  94 $r = '';
  95 for my $i (1 .. 3) {
  96     $r .= $i;
  97 }
  98 is ($r, '123', 'Forwards for list via .. with var');
  99 $r = '';
 100 for my $i ('A' .. 'C') {
 101     $r .= $i;
 102 }
 103 is ($r, 'ABC', 'Forwards for list via .. with var');
 104
 105 $r = '';
 106 for my $i (reverse @array) {
 107     $r .= $i;
 108 }
 109 is ($r, 'CBA', 'Reverse for array with var');
 110 $r = '';
 111 for my $i (reverse 1,2,3) {
 112     $r .= $i;
 113 }
 114 is ($r, '321', 'Reverse for list with var');
 115 $r = '';
 116 for my $i (reverse map {$_} @array) {
 117     $r .= $i;
 118 }
 119 is ($r, 'CBA', 'Reverse for array via map with var');
 120 $r = '';
 121 for my $i (reverse map {$_} 1,2,3) {
 122     $r .= $i;
 123 }
 124 is ($r, '321', 'Reverse for list via map with var');
 125 $r = '';
 126 for my $i (reverse 1 .. 3) {
 127     $r .= $i;
 128 }
 129 is ($r, '321', 'Reverse for list via .. with var');
 130 $r = '';
 131 for my $i (reverse 'A' .. 'C') {
 132     $r .= $i;
 133 }
 134 is ($r, 'CBA', 'Reverse for list via .. with var');
 135
 136 # For some reason the generate optree is different when $_ is implicit.
 137 $r = '';
 138 for $_ (@array) {
 139     $r .= $_;
 140 }
 141 is ($r, 'ABC', 'Forwards for array with explicit $_');
 142 $r = '';
 143 for $_ (1,2,3) {
 144     $r .= $_;
 145 }
 146 is ($r, '123', 'Forwards for list with explicit $_');
 147 $r = '';
 148 for $_ (map {$_} @array) {
 149     $r .= $_;
 150 }
 151 is ($r, 'ABC', 'Forwards for array via map with explicit $_');
 152 $r = '';
 153 for $_ (map {$_} 1,2,3) {
 154     $r .= $_;
 155 }
 156 is ($r, '123', 'Forwards for list via map with explicit $_');
 157 $r = '';
 158 for $_ (1 .. 3) {
 159     $r .= $_;
 160 }
 161 is ($r, '123', 'Forwards for list via .. with var with explicit $_');
 162 $r = '';
 163 for $_ ('A' .. 'C') {
 164     $r .= $_;
 165 }
 166 is ($r, 'ABC', 'Forwards for list via .. with var with explicit $_');
 167
 168 $r = '';
 169 for $_ (reverse @array) {
 170     $r .= $_;
 171 }
 172 is ($r, 'CBA', 'Reverse for array with explicit $_');
 173 $r = '';
 174 for $_ (reverse 1,2,3) {
 175     $r .= $_;
 176 }
 177 is ($r, '321', 'Reverse for list with explicit $_');
 178 $r = '';
 179 for $_ (reverse map {$_} @array) {
 180     $r .= $_;
 181 }
 182 is ($r, 'CBA', 'Reverse for array via map with explicit $_');
 183 $r = '';
 184 for $_ (reverse map {$_} 1,2,3) {
 185     $r .= $_;
 186 }
 187 is ($r, '321', 'Reverse for list via map with explicit $_');
 188 $r = '';
 189 for $_ (reverse 1 .. 3) {
 190     $r .= $_;
 191 }
 192 is ($r, '321', 'Reverse for list via .. with var with explicit $_');
 193 $r = '';
 194 for $_ (reverse 'A' .. 'C') {
 195     $r .= $_;
 196 }
 197 is ($r, 'CBA', 'Reverse for list via .. with var with explicit $_');
 198
 199 # I don't think that my is that different from our in the optree. But test a
 200 # few:
 201 $r = '';
 202 for our $i (reverse @array) {
 203     $r .= $i;
 204 }
 205 is ($r, 'CBA', 'Reverse for array with our var');
 206 $r = '';
 207 for our $i (reverse 1,2,3) {
 208     $r .= $i;
 209 }
 210 is ($r, '321', 'Reverse for list with our var');
 211 $r = '';
 212 for our $i (reverse map {$_} @array) {
 213     $r .= $i;
 214 }
 215 is ($r, 'CBA', 'Reverse for array via map with our var');
 216 $r = '';
 217 for our $i (reverse map {$_} 1,2,3) {
 218     $r .= $i;
 219 }
 220 is ($r, '321', 'Reverse for list via map with our var');
 221 $r = '';
 222 for our $i (reverse 1 .. 3) {
 223     $r .= $i;
 224 }
 225 is ($r, '321', 'Reverse for list via .. with our var');
 226 $r = '';
 227 for our $i (reverse 'A' .. 'C') {
 228     $r .= $i;
 229 }
 230 is ($r, 'CBA', 'Reverse for list via .. with our var');
 231
 232
 233 $r = '';
 234 for (1, reverse @array) {
 235     $r .= $_;
 236 }
 237 is ($r, '1CBA', 'Reverse for array with leading value');
 238 $r = '';
 239 for ('A', reverse 1,2,3) {
 240     $r .= $_;
 241 }
 242 is ($r, 'A321', 'Reverse for list with leading value');
 243 $r = '';
 244 for (1, reverse map {$_} @array) {
 245     $r .= $_;
 246 }
 247 is ($r, '1CBA', 'Reverse for array via map with leading value');
 248 $r = '';
 249 for ('A', reverse map {$_} 1,2,3) {
 250     $r .= $_;
 251 }
 252 is ($r, 'A321', 'Reverse for list via map with leading value');
 253 $r = '';
 254 for ('A', reverse 1 .. 3) {
 255     $r .= $_;
 256 }
 257 is ($r, 'A321', 'Reverse for list via .. with leading value');
 258 $r = '';
 259 for (1, reverse 'A' .. 'C') {
 260     $r .= $_;
 261 }
 262 is ($r, '1CBA', 'Reverse for list via .. with leading value');
 263
 264 $r = '';
 265 for (reverse (@array), 1) {
 266     $r .= $_;
 267 }
 268 is ($r, 'CBA1', 'Reverse for array with trailing value');
 269 $r = '';
 270 for (reverse (1,2,3), 'A') {
 271     $r .= $_;
 272 }
 273 is ($r, '321A', 'Reverse for list with trailing value');
 274 $r = '';
 275 for (reverse (map {$_} @array), 1) {
 276     $r .= $_;
 277 }
 278 is ($r, 'CBA1', 'Reverse for array via map with trailing value');
 279 $r = '';
 280 for (reverse (map {$_} 1,2,3), 'A') {
 281     $r .= $_;
 282 }
 283 is ($r, '321A', 'Reverse for list via map with trailing value');
 284 $r = '';
 285 for (reverse (1 .. 3), 'A') {
 286     $r .= $_;
 287 }
 288 is ($r, '321A', 'Reverse for list via .. with trailing value');
 289 $r = '';
 290 for (reverse ('A' .. 'C'), 1) {
 291     $r .= $_;
 292 }
 293 is ($r, 'CBA1', 'Reverse for list via .. with trailing value');
 294
 295
 296 $r = '';
 297 for $_ (1, reverse @array) {
 298     $r .= $_;
 299 }
 300 is ($r, '1CBA', 'Reverse for array with leading value with explicit $_');
 301 $r = '';
 302 for $_ ('A', reverse 1,2,3) {
 303     $r .= $_;
 304 }
 305 is ($r, 'A321', 'Reverse for list with leading value with explicit $_');
 306 $r = '';
 307 for $_ (1, reverse map {$_} @array) {
 308     $r .= $_;
 309 }
 310 is ($r, '1CBA',
 311     'Reverse for array via map with leading value with explicit $_');
 312 $r = '';
 313 for $_ ('A', reverse map {$_} 1,2,3) {
 314     $r .= $_;
 315 }
 316 is ($r, 'A321', 'Reverse for list via map with leading value with explicit $_');
 317 $r = '';
 318 for $_ ('A', reverse 1 .. 3) {
 319     $r .= $_;
 320 }
 321 is ($r, 'A321', 'Reverse for list via .. with leading value with explicit $_');
 322 $r = '';
 323 for $_ (1, reverse 'A' .. 'C') {
 324     $r .= $_;
 325 }
 326 is ($r, '1CBA', 'Reverse for list via .. 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 $r = '';
 351 for $_ (reverse (1 .. 3), 'A') {
 352     $r .= $_;
 353 }
 354 is ($r, '321A', 'Reverse for list via .. with trailing value with explicit $_');
 355 $r = '';
 356 for $_ (reverse ('A' .. 'C'), 1) {
 357     $r .= $_;
 358 }
 359 is ($r, 'CBA1', 'Reverse for list via .. with trailing value with explicit $_');
 360
 361 $r = '';
 362 for my $i (1, reverse @array) {
 363     $r .= $i;
 364 }
 365 is ($r, '1CBA', 'Reverse for array with leading value and var');
 366 $r = '';
 367 for my $i ('A', reverse 1,2,3) {
 368     $r .= $i;
 369 }
 370 is ($r, 'A321', 'Reverse for list with leading value and var');
 371 $r = '';
 372 for my $i (1, reverse map {$_} @array) {
 373     $r .= $i;
 374 }
 375 is ($r, '1CBA', 'Reverse for array via map with leading value and var');
 376 $r = '';
 377 for my $i ('A', reverse map {$_} 1,2,3) {
 378     $r .= $i;
 379 }
 380 is ($r, 'A321', 'Reverse for list via map with leading value and var');
 381 $r = '';
 382 for my $i ('A', reverse 1 .. 3) {
 383     $r .= $i;
 384 }
 385 is ($r, 'A321', 'Reverse for list via .. with leading value and var');
 386 $r = '';
 387 for my $i (1, reverse 'A' .. 'C') {
 388     $r .= $i;
 389 }
 390 is ($r, '1CBA', 'Reverse for list via .. with leading value and var');
 391
 392 $r = '';
 393 for my $i (reverse (@array), 1) {
 394     $r .= $i;
 395 }
 396 is ($r, 'CBA1', 'Reverse for array with trailing value and var');
 397 $r = '';
 398 for my $i (reverse (1,2,3), 'A') {
 399     $r .= $i;
 400 }
 401 is ($r, '321A', 'Reverse for list with trailing value and var');
 402 $r = '';
 403 for my $i (reverse (map {$_} @array), 1) {
 404     $r .= $i;
 405 }
 406 is ($r, 'CBA1', 'Reverse for array via map with trailing value and var');
 407 $r = '';
 408 for my $i (reverse (map {$_} 1,2,3), 'A') {
 409     $r .= $i;
 410 }
 411 is ($r, '321A', 'Reverse for list via map with trailing value and var');
 412 $r = '';
 413 for my $i (reverse (1 .. 3), 'A') {
 414     $r .= $i;
 415 }
 416 is ($r, '321A', 'Reverse for list via .. with trailing value and var');
 417 $r = '';
 418 for my $i (reverse ('A' .. 'C'), 1) {
 419     $r .= $i;
 420 }
 421 is ($r, 'CBA1', 'Reverse for list via .. with trailing value and var');
 422
 423
 424 $r = '';
 425 for (reverse 1, @array) {
 426     $r .= $_;
 427 }
 428 is ($r, 'CBA1', 'Reverse for value and array');
 429 $r = '';
 430 for (reverse map {$_} 1, @array) {
 431     $r .= $_;
 432 }
 433 is ($r, 'CBA1', 'Reverse for value and array via map');
 434 $r = '';
 435 for (reverse 1 .. 3, @array) {
 436     $r .= $_;
 437 }
 438 is ($r, 'CBA321', 'Reverse for .. and array');
 439 $r = '';
 440 for (reverse 'X' .. 'Z', @array) {
 441     $r .= $_;
 442 }
 443 is ($r, 'CBAZYX', 'Reverse for .. and array');
 444 $r = '';
 445 for (reverse map {$_} 1 .. 3, @array) {
 446     $r .= $_;
 447 }
 448 is ($r, 'CBA321', 'Reverse for .. and array via map');
 449 $r = '';
 450 for (reverse map {$_} 'X' .. 'Z', @array) {
 451     $r .= $_;
 452 }
 453 is ($r, 'CBAZYX', 'Reverse for .. and array via map');
 454
 455 $r = '';
 456 for (reverse (@array, 1)) {
 457     $r .= $_;
 458 }
 459 is ($r, '1CBA', 'Reverse for array and value');
 460 $r = '';
 461 for (reverse (map {$_} @array, 1)) {
 462     $r .= $_;
 463 }
 464 is ($r, '1CBA', 'Reverse for array and value via map');
 465
 466 $r = '';
 467 for $_ (reverse 1, @array) {
 468     $r .= $_;
 469 }
 470 is ($r, 'CBA1', 'Reverse for value and array with explicit $_');
 471 $r = '';
 472 for $_ (reverse map {$_} 1, @array) {
 473     $r .= $_;
 474 }
 475 is ($r, 'CBA1', 'Reverse for value and array via map with explicit $_');
 476 $r = '';
 477 for $_ (reverse 1 .. 3, @array) {
 478     $r .= $_;
 479 }
 480 is ($r, 'CBA321', 'Reverse for .. and array with explicit $_');
 481 $r = '';
 482 for $_ (reverse 'X' .. 'Z', @array) {
 483     $r .= $_;
 484 }
 485 is ($r, 'CBAZYX', 'Reverse for .. and array with explicit $_');
 486 $r = '';
 487 for $_ (reverse map {$_} 1 .. 3, @array) {
 488     $r .= $_;
 489 }
 490 is ($r, 'CBA321', 'Reverse for .. and array via map with explicit $_');
 491 $r = '';
 492 for $_ (reverse map {$_} 'X' .. 'Z', @array) {
 493     $r .= $_;
 494 }
 495 is ($r, 'CBAZYX', 'Reverse for .. and array via map with explicit $_');
 496
 497 $r = '';
 498 for $_ (reverse (@array, 1)) {
 499     $r .= $_;
 500 }
 501 is ($r, '1CBA', 'Reverse for array and value with explicit $_');
 502 $r = '';
 503 for $_ (reverse (map {$_} @array, 1)) {
 504     $r .= $_;
 505 }
 506 is ($r, '1CBA', 'Reverse for array and value via map with explicit $_');
 507
 508
 509 $r = '';
 510 for my $i (reverse 1, @array) {
 511     $r .= $i;
 512 }
 513 is ($r, 'CBA1', 'Reverse for value and array with var');
 514 $r = '';
 515 for my $i (reverse map {$_} 1, @array) {
 516     $r .= $i;
 517 }
 518 is ($r, 'CBA1', 'Reverse for value and array via map with var');
 519 $r = '';
 520 for my $i (reverse 1 .. 3, @array) {
 521     $r .= $i;
 522 }
 523 is ($r, 'CBA321', 'Reverse for .. and array with var');
 524 $r = '';
 525 for my $i (reverse 'X' .. 'Z', @array) {
 526     $r .= $i;
 527 }
 528 is ($r, 'CBAZYX', 'Reverse for .. and array with var');
 529 $r = '';
 530 for my $i (reverse map {$_} 1 .. 3, @array) {
 531     $r .= $i;
 532 }
 533 is ($r, 'CBA321', 'Reverse for .. and array via map with var');
 534 $r = '';
 535 for my $i (reverse map {$_} 'X' .. 'Z', @array) {
 536     $r .= $i;
 537 }
 538 is ($r, 'CBAZYX', 'Reverse for .. and array via map with var');
 539
 540 $r = '';
 541 for my $i (reverse (@array, 1)) {
 542     $r .= $i;
 543 }
 544 is ($r, '1CBA', 'Reverse for array and value with var');
 545 $r = '';
 546 for my $i (reverse (map {$_} @array, 1)) {
 547     $r .= $i;
 548 }
 549 is ($r, '1CBA', 'Reverse for array and value via map with var');
 550
 551 is do {17; foreach (1, 2) { 1; } }, '', "RT #1085: what should be output of perl -we 'print do { foreach (1, 2) { 1; } }'";
 552
 553 TODO: {
 554     local $TODO = "RT #2166: foreach spuriously autovivifies";
 555     my %h;
 556     foreach (@h{a, b}) {}
 557     is keys(%h), 0, 'RT #2166: foreach spuriously autovivifies';
 558 }
 559
 560 sub {
 561     foreach (@_) {
 562         is eval { \$_ }, \undef, 'foreach (@array_containing_undef)'
 563     }
 564 }->(undef);
 565
 566 SKIP: {
 567     skip "No XS::APItest under miniperl", 1, if is_miniperl;
 568     skip "no XS::APItest", 1 if !eval { require XS::APItest };
 569     my @a;
 570     sub {
 571         XS::APItest::alias_av(\@a, 0, undef);
 572         eval { \$_[0] }
 573     }->($a[0]);
 574     is $@, "", 'vivify_defelem does not croak on &PL_sv_undef elements';
 575 }
 576
 577 for $x ($y) {
 578     $x = 3;
 579     ($x, my $z) = (1, $y);
 580     is $z, 3, 'list assignment after aliasing via foreach';
 581 }
 582
 583 for my $x (my $y) {
 584     $x = 3;
 585     ($x, my $z) = (1, $y);
 586     is $z, 3, 'list assignment after aliasing lexical var via foreach';
 587 }
 588
 589 @_ = ();
 590 @_ = (1,2,3,scalar do{for(@_){}} + 1, 4, 5, 6);
 591 is "@_", "1 2 3 1 4 5 6",
 592    '[perl #124004] scalar for(@empty_array) stack bug';
 593
 594 # DAPM: while messing with the scope code, I broke some cpan/ code,
 595 # but surprisingly didn't break any dedicated tests. So test it:
 596
 597 sub fscope {
 598     for my $y (1,2) {
 599         my $a = $y;
 600         return $a;
 601     }
 602 }
 603
 604 is(fscope(), 1, 'return via loop in sub');
 605
 606 # make sure a NULL GvSV is restored at the end of the loop
 607
 608 {
 609     local $foo = "boo";
 610     {
 611         local *foo;
 612         for $foo (1,2) {}
 613         ok(!defined $foo, "NULL GvSV");
 614     }
 615 }
 616
 617 # make sure storing an int in a NULL GvSV is ok
 618
 619 {
 620     local $foo = "boo";
 621     {
 622         local *foo;
 623         for $foo (1..2) {}
 624         ok(!defined $foo, "NULL GvSV int iterator");
 625     }
 626 }
 627
 628 # RT #123994 - handle a null GVSV within a loop
 629
 630 {
 631     local *foo;
 632     local $foo = "outside";
 633
 634     my $i = 0;
 635     for $foo (0..1) {
 636         is($foo, $i, "RT #123994 int range $i");
 637         *foo = "";
 638         $i++;
 639     }
 640     is($foo, "outside", "RT #123994 int range outside");
 641
 642     $i = 0;
 643     for $foo ('0'..'1') {
 644         is($foo, $i, "RT #123994 str range $i");
 645         *foo = "";
 646         $i++;
 647     }
 648     is($foo, "outside", "RT #123994 str range outside");
 649
 650     $i = 0;
 651     for $foo (0, 1) {
 652         is($foo, $i, "RT #123994 list $i");
 653         *foo = "";
 654         $i++;
 655     }
 656     is($foo, "outside", "RT #123994 list outside");
 657
 658     my @a = (0,1);
 659     $i = 0;
 660     for $foo (@a) {
 661         is($foo, $i, "RT #123994 array $i");
 662         *foo = "";
 663         $i++;
 664     }
 665     is($foo, "outside", "RT #123994 array outside");
 666 }