t/cmd/for.t

   1 #!./perl
   2
   3 print "1..58\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
 197 # I don't think that my is that different from our in the optree. But test a
 198 # few:
 199 $r = '';
 200 for our $i (reverse @array) {
 201     $r .= $i;
 202 }
 203 is ($r, 'CBA', 'Reverse for array with our var');
 204 $r = '';
 205 for our $i (reverse 1,2,3) {
 206     $r .= $i;
 207 }
 208 is ($r, '321', 'Reverse for list with our var');
 209 $r = '';
 210 for our $i (reverse map {$_} @array) {
 211     $r .= $i;
 212 }
 213 is ($r, 'CBA', 'Reverse for array via map with our var');
 214 $r = '';
 215 for our $i (reverse map {$_} 1,2,3) {
 216     $r .= $i;
 217 }
 218 is ($r, '321', 'Reverse for list via map with our var');
 219
 220
 221 $r = '';
 222 for (1, reverse @array) {
 223     $r .= $_;
 224 }
 225 is ($r, '1CBA', 'Reverse for array with leading value');
 226 $r = '';
 227 for ('A', reverse 1,2,3) {
 228     $r .= $_;
 229 }
 230 is ($r, 'A321', 'Reverse for list with leading value');
 231 $r = '';
 232 for (1, reverse map {$_} @array) {
 233     $r .= $_;
 234 }
 235 is ($r, '1CBA', 'Reverse for array via map with leading value');
 236 $r = '';
 237 for ('A', reverse map {$_} 1,2,3) {
 238     $r .= $_;
 239 }
 240 is ($r, 'A321', 'Reverse for list via map with leading value');
 241
 242 $r = '';
 243 for (reverse (@array), 1) {
 244     $r .= $_;
 245 }
 246 is ($r, 'CBA1', 'Reverse for array with trailing value');
 247 $r = '';
 248 for (reverse (1,2,3), 'A') {
 249     $r .= $_;
 250 }
 251 is ($r, '321A', 'Reverse for list with trailing value');
 252 $r = '';
 253 for (reverse (map {$_} @array), 1) {
 254     $r .= $_;
 255 }
 256 is ($r, 'CBA1', 'Reverse for array via map with trailing value');
 257 $r = '';
 258 for (reverse (map {$_} 1,2,3), 'A') {
 259     $r .= $_;
 260 }
 261 is ($r, '321A', 'Reverse for list via map with trailing value');
 262
 263
 264 $r = '';
 265 for my $i (1, reverse @array) {
 266     $r .= $i;
 267 }
 268 is ($r, '1CBA', 'Reverse for array with leading value and var');
 269 $r = '';
 270 for my $i ('A', reverse 1,2,3) {
 271     $r .= $i;
 272 }
 273 is ($r, 'A321', 'Reverse for list with leading value and var');
 274 $r = '';
 275 for my $i (1, reverse map {$_} @array) {
 276     $r .= $i;
 277 }
 278 is ($r, '1CBA', 'Reverse for array via map with leading value and var');
 279 $r = '';
 280 for my $i ('A', reverse map {$_} 1,2,3) {
 281     $r .= $i;
 282 }
 283 is ($r, 'A321', 'Reverse for list via map with leading value and var');
 284
 285 $r = '';
 286 for my $i (reverse (@array), 1) {
 287     $r .= $i;
 288 }
 289 is ($r, 'CBA1', 'Reverse for array with trailing value and var');
 290 $r = '';
 291 for my $i (reverse (1,2,3), 'A') {
 292     $r .= $i;
 293 }
 294 is ($r, '321A', 'Reverse for list with trailing value and var');
 295 $r = '';
 296 for my $i (reverse (map {$_} @array), 1) {
 297     $r .= $i;
 298 }
 299 is ($r, 'CBA1', 'Reverse for array via map with trailing value and var');
 300 $r = '';
 301 for my $i (reverse (map {$_} 1,2,3), 'A') {
 302     $r .= $i;
 303 }
 304 is ($r, '321A', 'Reverse for list via map with trailing value and var');
 305
 306
 307 $r = '';
 308 for (reverse 1, @array) {
 309     $r .= $_;
 310 }
 311 is ($r, 'CBA1', 'Reverse for value and array');
 312 $r = '';
 313 for (reverse map {$_} 1, @array) {
 314     $r .= $_;
 315 }
 316 is ($r, 'CBA1', 'Reverse for value and array via map');
 317
 318 $r = '';
 319 for (reverse (@array, 1)) {
 320     $r .= $_;
 321 }
 322 is ($r, '1CBA', 'Reverse for array and value');
 323 $r = '';
 324 for (reverse (map {$_} @array, 1)) {
 325     $r .= $_;
 326 }
 327 is ($r, '1CBA', 'Reverse for array and value via map');
 328
 329
 330 $r = '';
 331 for my $i (reverse 1, @array) {
 332     $r .= $i;
 333 }
 334 is ($r, 'CBA1', 'Reverse for value and array with var');
 335 $r = '';
 336 for my $i (reverse map {$_} 1, @array) {
 337     $r .= $i;
 338 }
 339 is ($r, 'CBA1', 'Reverse for value and array via map with var');
 340
 341 $r = '';
 342 for my $i (reverse (@array, 1)) {
 343     $r .= $i;
 344 }
 345 is ($r, '1CBA', 'Reverse for array and value with var');
 346 $r = '';
 347 for my $i (reverse (map {$_} @array, 1)) {
 348     $r .= $i;
 349 }
 350 is ($r, '1CBA', 'Reverse for array and value via map with var');