t/cmd/for.t

   1 #!./perl
   2
   3 print "1..16\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 # [perl #78194] foreach() aliasing op return values
  99 for ("${\''}") {
 100     print "not " unless \$_ == \$_;
 101     print 'ok 15 - [perl \#78194] \$_ == \$_ inside for("$x"){...}',
 102           "\n";
 103 }
 104
 105 # [perl #123286] Lone C-style for in a block messes up the stack
 106 @_ = (1..3, do {for(0;0;){}}, 4..6);
 107 print "not " unless "@_" eq '1 2 3 0 4 5 6';
 108 print "ok 16 - [perl #78194] Lone C-style for in a block\n";