t/op/loopctl.t

   1 #!./perl
   2
   3 # We have the following types of loop:
   4 #
   5 # 1a)  while(A) {B}
   6 # 1b)  B while A;
   7 #
   8 # 2a)  until(A) {B}
   9 # 2b)  B until A;
  10 #
  11 # 3a)  for(@A)  {B}
  12 # 3b)  B for A;
  13 #
  14 # 4a)  for (A;B;C) {D}
  15 #
  16 # 5a)  { A }        # a bare block is a loop which runs once
  17 #
  18 # Loops of type (b) don't allow for next/last/redo style
  19 #  control, so we ignore them here. Type (a) loops can
  20 #  all be labelled, so there are ten possibilities (each
  21 #  of 5 types, labelled/unlabelled). We therefore need
  22 #  thirty tests to try the three control statements against
  23 #  the ten types of loop. For the first four types it's useful
  24 #  to distinguish the case where next re-iterates from the case
  25 #  where it leaves the loop. That makes 38.
  26 # All these tests rely on "last LABEL"
  27 #  so if they've *all* failed, maybe you broke that...
  28 #
  29 # These tests are followed by an extra test of nested loops.
  30 # Feel free to add more here.
  31 #
  32 #  -- .robin. <robin@kitsite.com>  2001-03-13
  33
  34 print "1..41\n";
  35
  36 my $ok;
  37
  38 ## while() loop without a label
  39
  40 TEST1: { # redo
  41
  42   $ok = 0;
  43
  44   my $x = 1;
  45   my $first_time = 1;
  46   while($x--) {
  47     if (!$first_time) {
  48       $ok = 1;
  49       last TEST1;
  50     }
  51     $ok = 0;
  52     $first_time = 0;
  53     redo;
  54     last TEST1;
  55   }
  56   continue {
  57     $ok = 0;
  58     last TEST1;
  59   }
  60   $ok = 0;
  61 }
  62 print ($ok ? "ok 1\n" : "not ok 1\n");
  63
  64 TEST2: { # next (succesful)
  65
  66   $ok = 0;
  67
  68   my $x = 2;
  69   my $first_time = 1;
  70   my $been_in_continue = 0;
  71   while($x--) {
  72     if (!$first_time) {
  73       $ok = $been_in_continue;
  74       last TEST2;
  75     }
  76     $ok = 0;
  77     $first_time = 0;
  78     next;
  79     last TEST2;
  80   }
  81   continue {
  82     $been_in_continue = 1;
  83   }
  84   $ok = 0;
  85 }
  86 print ($ok ? "ok 2\n" : "not ok 2\n");
  87
  88 TEST3: { # next (unsuccesful)
  89
  90   $ok = 0;
  91
  92   my $x = 1;
  93   my $first_time = 1;
  94   my $been_in_loop = 0;
  95   my $been_in_continue = 0;
  96   while($x--) {
  97     $been_in_loop = 1;
  98     if (!$first_time) {
  99       $ok = 0;
 100       last TEST3;
 101     }
 102     $ok = 0;
 103     $first_time = 0;
 104     next;
 105     last TEST3;
 106   }
 107   continue {
 108     $been_in_continue = 1;
 109   }
 110   $ok = $been_in_loop && $been_in_continue;
 111 }
 112 print ($ok ? "ok 3\n" : "not ok 3\n");
 113
 114 TEST4: { # last
 115
 116   $ok = 0;
 117
 118   my $x = 1;
 119   my $first_time = 1;
 120   while($x++) {
 121     if (!$first_time) {
 122       $ok = 0;
 123       last TEST4;
 124     }
 125     $ok = 0;
 126     $first_time = 0;
 127     last;
 128     last TEST4;
 129   }
 130   continue {
 131     $ok = 0;
 132     last TEST4;
 133   }
 134   $ok = 1;
 135 }
 136 print ($ok ? "ok 4\n" : "not ok 4\n");
 137
 138
 139 ## until() loop without a label
 140
 141 TEST5: { # redo
 142
 143   $ok = 0;
 144
 145   my $x = 0;
 146   my $first_time = 1;
 147   until($x++) {
 148     if (!$first_time) {
 149       $ok = 1;
 150       last TEST5;
 151     }
 152     $ok = 0;
 153     $first_time = 0;
 154     redo;
 155     last TEST5;
 156   }
 157   continue {
 158     $ok = 0;
 159     last TEST5;
 160   }
 161   $ok = 0;
 162 }
 163 print ($ok ? "ok 5\n" : "not ok 5\n");
 164
 165 TEST6: { # next (succesful)
 166
 167   $ok = 0;
 168
 169   my $x = 0;
 170   my $first_time = 1;
 171   my $been_in_continue = 0;
 172   until($x++ >= 2) {
 173     if (!$first_time) {
 174       $ok = $been_in_continue;
 175       last TEST6;
 176     }
 177     $ok = 0;
 178     $first_time = 0;
 179     next;
 180     last TEST6;
 181   }
 182   continue {
 183     $been_in_continue = 1;
 184   }
 185   $ok = 0;
 186 }
 187 print ($ok ? "ok 6\n" : "not ok 6\n");
 188
 189 TEST7: { # next (unsuccesful)
 190
 191   $ok = 0;
 192
 193   my $x = 0;
 194   my $first_time = 1;
 195   my $been_in_loop = 0;
 196   my $been_in_continue = 0;
 197   until($x++) {
 198     $been_in_loop = 1;
 199     if (!$first_time) {
 200       $ok = 0;
 201       last TEST7;
 202     }
 203     $ok = 0;
 204     $first_time = 0;
 205     next;
 206     last TEST7;
 207   }
 208   continue {
 209     $been_in_continue = 1;
 210   }
 211   $ok = $been_in_loop && $been_in_continue;
 212 }
 213 print ($ok ? "ok 7\n" : "not ok 7\n");
 214
 215 TEST8: { # last
 216
 217   $ok = 0;
 218
 219   my $x = 0;
 220   my $first_time = 1;
 221   until($x++ == 10) {
 222     if (!$first_time) {
 223       $ok = 0;
 224       last TEST8;
 225     }
 226     $ok = 0;
 227     $first_time = 0;
 228     last;
 229     last TEST8;
 230   }
 231   continue {
 232     $ok = 0;
 233     last TEST8;
 234   }
 235   $ok = 1;
 236 }
 237 print ($ok ? "ok 8\n" : "not ok 8\n");
 238
 239 ## for(@array) loop without a label
 240
 241 TEST9: { # redo
 242
 243   $ok = 0;
 244
 245   my $first_time = 1;
 246   for(1) {
 247     if (!$first_time) {
 248       $ok = 1;
 249       last TEST9;
 250     }
 251     $ok = 0;
 252     $first_time = 0;
 253     redo;
 254     last TEST9;
 255   }
 256   continue {
 257     $ok = 0;
 258     last TEST9;
 259   }
 260   $ok = 0;
 261 }
 262 print ($ok ? "ok 9\n" : "not ok 9\n");
 263
 264 TEST10: { # next (succesful)
 265
 266   $ok = 0;
 267
 268   my $first_time = 1;
 269   my $been_in_continue = 0;
 270   for(1,2) {
 271     if (!$first_time) {
 272       $ok = $been_in_continue;
 273       last TEST10;
 274     }
 275     $ok = 0;
 276     $first_time = 0;
 277     next;
 278     last TEST10;
 279   }
 280   continue {
 281     $been_in_continue = 1;
 282   }
 283   $ok = 0;
 284 }
 285 print ($ok ? "ok 10\n" : "not ok 10\n");
 286
 287 TEST11: { # next (unsuccesful)
 288
 289   $ok = 0;
 290
 291   my $first_time = 1;
 292   my $been_in_loop = 0;
 293   my $been_in_continue = 0;
 294   for(1) {
 295     $been_in_loop = 1;
 296     if (!$first_time) {
 297       $ok = 0;
 298       last TEST11;
 299     }
 300     $ok = 0;
 301     $first_time = 0;
 302     next;
 303     last TEST11;
 304   }
 305   continue {
 306     $been_in_continue = 1;
 307   }
 308   $ok = $been_in_loop && $been_in_continue;
 309 }
 310 print ($ok ? "ok 11\n" : "not ok 11\n");
 311
 312 TEST12: { # last
 313
 314   $ok = 0;
 315
 316   my $first_time = 1;
 317   for(1..10) {
 318     if (!$first_time) {
 319       $ok = 0;
 320       last TEST12;
 321     }
 322     $ok = 0;
 323     $first_time = 0;
 324     last;
 325     last TEST12;
 326   }
 327   continue {
 328     $ok=0;
 329     last TEST12;
 330   }
 331   $ok = 1;
 332 }
 333 print ($ok ? "ok 12\n" : "not ok 12\n");
 334
 335 ## for(;;) loop without a label
 336
 337 TEST13: { # redo
 338
 339   $ok = 0;
 340
 341   for(my $first_time = 1; 1;) {
 342     if (!$first_time) {
 343       $ok = 1;
 344       last TEST13;
 345     }
 346     $ok = 0;
 347     $first_time=0;
 348
 349     redo;
 350     last TEST13;
 351   }
 352   $ok = 0;
 353 }
 354 print ($ok ? "ok 13\n" : "not ok 13\n");
 355
 356 TEST14: { # next (successful)
 357
 358   $ok = 0;
 359
 360   for(my $first_time = 1; 1; $first_time=0) {
 361     if (!$first_time) {
 362       $ok = 1;
 363       last TEST14;
 364     }
 365     $ok = 0;
 366     next;
 367     last TEST14;
 368   }
 369   $ok = 0;
 370 }
 371 print ($ok ? "ok 14\n" : "not ok 14\n");
 372
 373 TEST15: { # next (unsuccesful)
 374
 375   $ok = 0;
 376
 377   my $x=1;
 378   my $been_in_loop = 0;
 379   for(my $first_time = 1; $x--;) {
 380     $been_in_loop = 1;
 381     if (!$first_time) {
 382       $ok = 0;
 383       last TEST15;
 384     }
 385     $ok = 0;
 386     $first_time = 0;
 387     next;
 388     last TEST15;
 389   }
 390   $ok = $been_in_loop;
 391 }
 392 print ($ok ? "ok 15\n" : "not ok 15\n");
 393
 394 TEST16: { # last
 395
 396   $ok = 0;
 397
 398   for(my $first_time = 1; 1; last TEST16) {
 399     if (!$first_time) {
 400       $ok = 0;
 401       last TEST16;
 402     }
 403     $ok = 0;
 404     $first_time = 0;
 405     last;
 406     last TEST16;
 407   }
 408   $ok = 1;
 409 }
 410 print ($ok ? "ok 16\n" : "not ok 16\n");
 411
 412 ## bare block without a label
 413
 414 TEST17: { # redo
 415
 416   $ok = 0;
 417   my $first_time = 1;
 418
 419   {
 420     if (!$first_time) {
 421       $ok = 1;
 422       last TEST17;
 423     }
 424     $ok = 0;
 425     $first_time=0;
 426
 427     redo;
 428     last TEST17;
 429   }
 430   continue {
 431     $ok = 0;
 432     last TEST17;
 433   }
 434   $ok = 0;
 435 }
 436 print ($ok ? "ok 17\n" : "not ok 17\n");
 437
 438 TEST18: { # next
 439
 440   $ok = 0;
 441   {
 442     next;
 443     last TEST18;
 444   }
 445   continue {
 446     $ok = 1;
 447     last TEST18;
 448   }
 449   $ok = 0;
 450 }
 451 print ($ok ? "ok 18\n" : "not ok 18\n");
 452
 453 TEST19: { # last
 454
 455   $ok = 0;
 456   {
 457     last;
 458     last TEST19;
 459   }
 460   continue {
 461     $ok = 0;
 462     last TEST19;
 463   }
 464   $ok = 1;
 465 }
 466 print ($ok ? "ok 19\n" : "not ok 19\n");
 467
 468
 469 ### Now do it all again with labels
 470
 471 ## while() loop with a label
 472
 473 TEST20: { # redo
 474
 475   $ok = 0;
 476
 477   my $x = 1;
 478   my $first_time = 1;
 479   LABEL20: while($x--) {
 480     if (!$first_time) {
 481       $ok = 1;
 482       last TEST20;
 483     }
 484     $ok = 0;
 485     $first_time = 0;
 486     redo LABEL20;
 487     last TEST20;
 488   }
 489   continue {
 490     $ok = 0;
 491     last TEST20;
 492   }
 493   $ok = 0;
 494 }
 495 print ($ok ? "ok 20\n" : "not ok 20\n");
 496
 497 TEST21: { # next (succesful)
 498
 499   $ok = 0;
 500
 501   my $x = 2;
 502   my $first_time = 1;
 503   my $been_in_continue = 0;
 504   LABEL21: while($x--) {
 505     if (!$first_time) {
 506       $ok = $been_in_continue;
 507       last TEST21;
 508     }
 509     $ok = 0;
 510     $first_time = 0;
 511     next LABEL21;
 512     last TEST21;
 513   }
 514   continue {
 515     $been_in_continue = 1;
 516   }
 517   $ok = 0;
 518 }
 519 print ($ok ? "ok 21\n" : "not ok 21\n");
 520
 521 TEST22: { # next (unsuccesful)
 522
 523   $ok = 0;
 524
 525   my $x = 1;
 526   my $first_time = 1;
 527   my $been_in_loop = 0;
 528   my $been_in_continue = 0;
 529   LABEL22: while($x--) {
 530     $been_in_loop = 1;
 531     if (!$first_time) {
 532       $ok = 0;
 533       last TEST22;
 534     }
 535     $ok = 0;
 536     $first_time = 0;
 537     next LABEL22;
 538     last TEST22;
 539   }
 540   continue {
 541     $been_in_continue = 1;
 542   }
 543   $ok = $been_in_loop && $been_in_continue;
 544 }
 545 print ($ok ? "ok 22\n" : "not ok 22\n");
 546
 547 TEST23: { # last
 548
 549   $ok = 0;
 550
 551   my $x = 1;
 552   my $first_time = 1;
 553   LABEL23: while($x++) {
 554     if (!$first_time) {
 555       $ok = 0;
 556       last TEST23;
 557     }
 558     $ok = 0;
 559     $first_time = 0;
 560     last LABEL23;
 561     last TEST23;
 562   }
 563   continue {
 564     $ok = 0;
 565     last TEST23;
 566   }
 567   $ok = 1;
 568 }
 569 print ($ok ? "ok 23\n" : "not ok 23\n");
 570
 571
 572 ## until() loop with a label
 573
 574 TEST24: { # redo
 575
 576   $ok = 0;
 577
 578   my $x = 0;
 579   my $first_time = 1;
 580   LABEL24: until($x++) {
 581     if (!$first_time) {
 582       $ok = 1;
 583       last TEST24;
 584     }
 585     $ok = 0;
 586     $first_time = 0;
 587     redo LABEL24;
 588     last TEST24;
 589   }
 590   continue {
 591     $ok = 0;
 592     last TEST24;
 593   }
 594   $ok = 0;
 595 }
 596 print ($ok ? "ok 24\n" : "not ok 24\n");
 597
 598 TEST25: { # next (succesful)
 599
 600   $ok = 0;
 601
 602   my $x = 0;
 603   my $first_time = 1;
 604   my $been_in_continue = 0;
 605   LABEL25: until($x++ >= 2) {
 606     if (!$first_time) {
 607       $ok = $been_in_continue;
 608       last TEST25;
 609     }
 610     $ok = 0;
 611     $first_time = 0;
 612     next LABEL25;
 613     last TEST25;
 614   }
 615   continue {
 616     $been_in_continue = 1;
 617   }
 618   $ok = 0;
 619 }
 620 print ($ok ? "ok 25\n" : "not ok 25\n");
 621
 622 TEST26: { # next (unsuccesful)
 623
 624   $ok = 0;
 625
 626   my $x = 0;
 627   my $first_time = 1;
 628   my $been_in_loop = 0;
 629   my $been_in_continue = 0;
 630   LABEL26: until($x++) {
 631     $been_in_loop = 1;
 632     if (!$first_time) {
 633       $ok = 0;
 634       last TEST26;
 635     }
 636     $ok = 0;
 637     $first_time = 0;
 638     next LABEL26;
 639     last TEST26;
 640   }
 641   continue {
 642     $been_in_continue = 1;
 643   }
 644   $ok = $been_in_loop && $been_in_continue;
 645 }
 646 print ($ok ? "ok 26\n" : "not ok 26\n");
 647
 648 TEST27: { # last
 649
 650   $ok = 0;
 651
 652   my $x = 0;
 653   my $first_time = 1;
 654   LABEL27: until($x++ == 10) {
 655     if (!$first_time) {
 656       $ok = 0;
 657       last TEST27;
 658     }
 659     $ok = 0;
 660     $first_time = 0;
 661     last LABEL27;
 662     last TEST27;
 663   }
 664   continue {
 665     $ok = 0;
 666     last TEST8;
 667   }
 668   $ok = 1;
 669 }
 670 print ($ok ? "ok 27\n" : "not ok 27\n");
 671
 672 ## for(@array) loop with a label
 673
 674 TEST28: { # redo
 675
 676   $ok = 0;
 677
 678   my $first_time = 1;
 679   LABEL28: for(1) {
 680     if (!$first_time) {
 681       $ok = 1;
 682       last TEST28;
 683     }
 684     $ok = 0;
 685     $first_time = 0;
 686     redo LABEL28;
 687     last TEST28;
 688   }
 689   continue {
 690     $ok = 0;
 691     last TEST28;
 692   }
 693   $ok = 0;
 694 }
 695 print ($ok ? "ok 28\n" : "not ok 28\n");
 696
 697 TEST29: { # next (succesful)
 698
 699   $ok = 0;
 700
 701   my $first_time = 1;
 702   my $been_in_continue = 0;
 703   LABEL29: for(1,2) {
 704     if (!$first_time) {
 705       $ok = $been_in_continue;
 706       last TEST29;
 707     }
 708     $ok = 0;
 709     $first_time = 0;
 710     next LABEL29;
 711     last TEST29;
 712   }
 713   continue {
 714     $been_in_continue = 1;
 715   }
 716   $ok = 0;
 717 }
 718 print ($ok ? "ok 29\n" : "not ok 29\n");
 719
 720 TEST30: { # next (unsuccesful)
 721
 722   $ok = 0;
 723
 724   my $first_time = 1;
 725   my $been_in_loop = 0;
 726   my $been_in_continue = 0;
 727   LABEL30: for(1) {
 728     $been_in_loop = 1;
 729     if (!$first_time) {
 730       $ok = 0;
 731       last TEST30;
 732     }
 733     $ok = 0;
 734     $first_time = 0;
 735     next LABEL30;
 736     last TEST30;
 737   }
 738   continue {
 739     $been_in_continue = 1;
 740   }
 741   $ok = $been_in_loop && $been_in_continue;
 742 }
 743 print ($ok ? "ok 30\n" : "not ok 30\n");
 744
 745 TEST31: { # last
 746
 747   $ok = 0;
 748
 749   my $first_time = 1;
 750   LABEL31: for(1..10) {
 751     if (!$first_time) {
 752       $ok = 0;
 753       last TEST31;
 754     }
 755     $ok = 0;
 756     $first_time = 0;
 757     last LABEL31;
 758     last TEST31;
 759   }
 760   continue {
 761     $ok=0;
 762     last TEST31;
 763   }
 764   $ok = 1;
 765 }
 766 print ($ok ? "ok 31\n" : "not ok 31\n");
 767
 768 ## for(;;) loop with a label
 769
 770 TEST32: { # redo
 771
 772   $ok = 0;
 773
 774   LABEL32: for(my $first_time = 1; 1;) {
 775     if (!$first_time) {
 776       $ok = 1;
 777       last TEST32;
 778     }
 779     $ok = 0;
 780     $first_time=0;
 781
 782     redo LABEL32;
 783     last TEST32;
 784   }
 785   $ok = 0;
 786 }
 787 print ($ok ? "ok 32\n" : "not ok 32\n");
 788
 789 TEST33: { # next (successful)
 790
 791   $ok = 0;
 792
 793   LABEL33: for(my $first_time = 1; 1; $first_time=0) {
 794     if (!$first_time) {
 795       $ok = 1;
 796       last TEST33;
 797     }
 798     $ok = 0;
 799     next LABEL33;
 800     last TEST33;
 801   }
 802   $ok = 0;
 803 }
 804 print ($ok ? "ok 33\n" : "not ok 33\n");
 805
 806 TEST34: { # next (unsuccesful)
 807
 808   $ok = 0;
 809
 810   my $x=1;
 811   my $been_in_loop = 0;
 812   LABEL34: for(my $first_time = 1; $x--;) {
 813     $been_in_loop = 1;
 814     if (!$first_time) {
 815       $ok = 0;
 816       last TEST34;
 817     }
 818     $ok = 0;
 819     $first_time = 0;
 820     next LABEL34;
 821     last TEST34;
 822   }
 823   $ok = $been_in_loop;
 824 }
 825 print ($ok ? "ok 34\n" : "not ok 34\n");
 826
 827 TEST35: { # last
 828
 829   $ok = 0;
 830
 831   LABEL35: for(my $first_time = 1; 1; last TEST16) {
 832     if (!$first_time) {
 833       $ok = 0;
 834       last TEST35;
 835     }
 836     $ok = 0;
 837     $first_time = 0;
 838     last LABEL35;
 839     last TEST35;
 840   }
 841   $ok = 1;
 842 }
 843 print ($ok ? "ok 35\n" : "not ok 35\n");
 844
 845 ## bare block with a label
 846
 847 TEST36: { # redo
 848
 849   $ok = 0;
 850   my $first_time = 1;
 851
 852   LABEL36: {
 853     if (!$first_time) {
 854       $ok = 1;
 855       last TEST36;
 856     }
 857     $ok = 0;
 858     $first_time=0;
 859
 860     redo LABEL36;
 861     last TEST36;
 862   }
 863   continue {
 864     $ok = 0;
 865     last TEST36;
 866   }
 867   $ok = 0;
 868 }
 869 print ($ok ? "ok 36\n" : "not ok 36\n");
 870
 871 TEST37: { # next
 872
 873   $ok = 0;
 874   LABEL37: {
 875     next LABEL37;
 876     last TEST37;
 877   }
 878   continue {
 879     $ok = 1;
 880     last TEST37;
 881   }
 882   $ok = 0;
 883 }
 884 print ($ok ? "ok 37\n" : "not ok 37\n");
 885
 886 TEST38: { # last
 887
 888   $ok = 0;
 889   LABEL38: {
 890     last LABEL38;
 891     last TEST38;
 892   }
 893   continue {
 894     $ok = 0;
 895     last TEST38;
 896   }
 897   $ok = 1;
 898 }
 899 print ($ok ? "ok 38\n" : "not ok 38\n");
 900
 901 ### Now test nested constructs
 902
 903 TEST39: {
 904     $ok = 0;
 905     my ($x, $y, $z) = (1,1,1);
 906     one39: while ($x--) {
 907       $ok = 0;
 908       two39: while ($y--) {
 909         $ok = 0;
 910         three39: while ($z--) {
 911            next two39;
 912         }
 913         continue {
 914           $ok = 0;
 915           last TEST39;
 916         }
 917       }
 918       continue {
 919         $ok = 1;
 920         last TEST39;
 921       }
 922       $ok = 0;
 923     }
 924 }
 925 print ($ok ? "ok 39\n" : "not ok 39\n");
 926
 927
 928 ### Test that loop control is dynamicly scoped.
 929
 930 sub test_last_label { last TEST40 }
 931
 932 TEST40: {
 933     $ok = 1;
 934     test_last_label();
 935     $ok = 0;
 936 }
 937 print ($ok ? "ok 40\n" : "not ok 40\n");
 938
 939 sub test_last { last }
 940
 941 TEST41: {
 942     $ok = 1;
 943     test_last();
 944     $ok = 0;
 945 }
 946 print ($ok ? "ok 41\n" : "not ok 41\n");