contrib/perl5/t/cmd/while.t

   1 #!./perl
   2
   3 # $RCSfile: while.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:15 $
   4
   5 print "1..15\n";
   6
   7 open (tmp,'>Cmd_while.tmp') || die "Can't create Cmd_while.tmp.";
   8 print tmp "tvi925\n";
   9 print tmp "tvi920\n";
  10 print tmp "vt100\n";
  11 print tmp "Amiga\n";
  12 print tmp "paper\n";
  13 close tmp;
  14
  15 # test "last" command
  16
  17 open(fh,'Cmd_while.tmp') || die "Can't open Cmd_while.tmp.";
  18 while (<fh>) {
  19     last if /vt100/;
  20 }
  21 if (!eof && /vt100/) {print "ok 1\n";} else {print "not ok 1 $_\n";}
  22
  23 # test "next" command
  24
  25 $bad = '';
  26 open(fh,'Cmd_while.tmp') || die "Can't open Cmd_while.tmp.";
  27 while (<fh>) {
  28     next if /vt100/;
  29     $bad = 1 if /vt100/;
  30 }
  31 if (!eof || /vt100/ || $bad) {print "not ok 2\n";} else {print "ok 2\n";}
  32
  33 # test "redo" command
  34
  35 $bad = '';
  36 open(fh,'Cmd_while.tmp') || die "Can't open Cmd_while.tmp.";
  37 while (<fh>) {
  38     if (s/vt100/VT100/g) {
  39         s/VT100/Vt100/g;
  40         redo;
  41     }
  42     $bad = 1 if /vt100/;
  43     $bad = 1 if /VT100/;
  44 }
  45 if (!eof || $bad) {print "not ok 3\n";} else {print "ok 3\n";}
  46
  47 # now do the same with a label and a continue block
  48
  49 # test "last" command
  50
  51 $badcont = '';
  52 open(fh,'Cmd_while.tmp') || die "Can't open Cmd_while.tmp.";
  53 line: while (<fh>) {
  54     if (/vt100/) {last line;}
  55 } continue {
  56     $badcont = 1 if /vt100/;
  57 }
  58 if (!eof && /vt100/) {print "ok 4\n";} else {print "not ok 4\n";}
  59 if (!$badcont) {print "ok 5\n";} else {print "not ok 5\n";}
  60
  61 # test "next" command
  62
  63 $bad = '';
  64 $badcont = 1;
  65 open(fh,'Cmd_while.tmp') || die "Can't open Cmd_while.tmp.";
  66 entry: while (<fh>) {
  67     next entry if /vt100/;
  68     $bad = 1 if /vt100/;
  69 } continue {
  70     $badcont = '' if /vt100/;
  71 }
  72 if (!eof || /vt100/ || $bad) {print "not ok 6\n";} else {print "ok 6\n";}
  73 if (!$badcont) {print "ok 7\n";} else {print "not ok 7\n";}
  74
  75 # test "redo" command
  76
  77 $bad = '';
  78 $badcont = '';
  79 open(fh,'Cmd_while.tmp') || die "Can't open Cmd_while.tmp.";
  80 loop: while (<fh>) {
  81     if (s/vt100/VT100/g) {
  82         s/VT100/Vt100/g;
  83         redo loop;
  84     }
  85     $bad = 1 if /vt100/;
  86     $bad = 1 if /VT100/;
  87 } continue {
  88     $badcont = 1 if /vt100/;
  89 }
  90 if (!eof || $bad) {print "not ok 8\n";} else {print "ok 8\n";}
  91 if (!$badcont) {print "ok 9\n";} else {print "not ok 9\n";}
  92
  93 close(fh) || die "Can't close Cmd_while.tmp.";
  94 unlink 'Cmd_while.tmp' || `/bin/rm Cmd_While.tmp`;
  95
  96 #$x = 0;
  97 #while (1) {
  98 #    if ($x > 1) {last;}
  99 #    next;
 100 #} continue {
 101 #    if ($x++ > 10) {last;}
 102 #    next;
 103 #}
 104 #
 105 #if ($x < 10) {print "ok 10\n";} else {print "not ok 10\n";}
 106
 107 $i = 9;
 108 {
 109     $i++;
 110 }
 111 print "ok $i\n";
 112
 113 # Check curpm is reset when jumping out of a scope
 114 'abc' =~ /b/;
 115 WHILE:
 116 while (1) {
 117   $i++;
 118   print "#$`,$&,$',\nnot " unless $` . $& . $' eq "abc";
 119   print "ok $i\n";
 120   {                             # Localize changes to $` and friends
 121     'end' =~ /end/;
 122     redo WHILE if $i == 11;
 123     next WHILE if $i == 12;
 124     # 13 do a normal loop
 125     last WHILE if $i == 14;
 126   }
 127 }
 128 $i++;
 129 print "not " unless $` . $& . $' eq "abc";
 130 print "ok $i\n";