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