New try at the Class::DBI core dump at global cleanup.
[p5sagit/p5-mst-13.2.git] / t / cmd / while.t
1 #!./perl
2
3 print "1..22\n";
4
5 open (tmp,'>Cmd_while.tmp') || die "Can't create Cmd_while.tmp.";
6 print tmp "tvi925\n";
7 print tmp "tvi920\n";
8 print tmp "vt100\n";
9 print tmp "Amiga\n";
10 print tmp "paper\n";
11 close tmp or die "Could not close: $!";
12
13 # test "last" command
14
15 open(fh,'Cmd_while.tmp') || die "Can't open Cmd_while.tmp.";
16 while (<fh>) {
17     last if /vt100/;
18 }
19 if (!eof && /vt100/) {print "ok 1\n";} else {print "not ok 1 $_\n";}
20
21 # test "next" command
22
23 $bad = '';
24 open(fh,'Cmd_while.tmp') || die "Can't open Cmd_while.tmp.";
25 while (<fh>) {
26     next if /vt100/;
27     $bad = 1 if /vt100/;
28 }
29 if (!eof || /vt100/ || $bad) {print "not ok 2\n";} else {print "ok 2\n";}
30
31 # test "redo" command
32
33 $bad = '';
34 open(fh,'Cmd_while.tmp') || die "Can't open Cmd_while.tmp.";
35 while (<fh>) {
36     if (s/vt100/VT100/g) {
37         s/VT100/Vt100/g;
38         redo;
39     }
40     $bad = 1 if /vt100/;
41     $bad = 1 if /VT100/;
42 }
43 if (!eof || $bad) {print "not ok 3\n";} else {print "ok 3\n";}
44
45 # now do the same with a label and a continue block
46
47 # test "last" command
48
49 $badcont = '';
50 open(fh,'Cmd_while.tmp') || die "Can't open Cmd_while.tmp.";
51 line: while (<fh>) {
52     if (/vt100/) {last line;}
53 } continue {
54     $badcont = 1 if /vt100/;
55 }
56 if (!eof && /vt100/) {print "ok 4\n";} else {print "not ok 4\n";}
57 if (!$badcont) {print "ok 5\n";} else {print "not ok 5\n";}
58
59 # test "next" command
60
61 $bad = '';
62 $badcont = 1;
63 open(fh,'Cmd_while.tmp') || die "Can't open Cmd_while.tmp.";
64 entry: while (<fh>) {
65     next entry if /vt100/;
66     $bad = 1 if /vt100/;
67 } continue {
68     $badcont = '' if /vt100/;
69 }
70 if (!eof || /vt100/ || $bad) {print "not ok 6\n";} else {print "ok 6\n";}
71 if (!$badcont) {print "ok 7\n";} else {print "not ok 7\n";}
72
73 # test "redo" command
74
75 $bad = '';
76 $badcont = '';
77 open(fh,'Cmd_while.tmp') || die "Can't open Cmd_while.tmp.";
78 loop: while (<fh>) {
79     if (s/vt100/VT100/g) {
80         s/VT100/Vt100/g;
81         redo loop;
82     }
83     $bad = 1 if /vt100/;
84     $bad = 1 if /VT100/;
85 } continue {
86     $badcont = 1 if /vt100/;
87 }
88 if (!eof || $bad) {print "not ok 8\n";} else {print "ok 8\n";}
89 if (!$badcont) {print "ok 9\n";} else {print "not ok 9\n";}
90
91 close(fh) || die "Can't close Cmd_while.tmp.";
92 unlink 'Cmd_while.tmp' || `/bin/rm Cmd_While.tmp`;
93
94 #$x = 0;
95 #while (1) {
96 #    if ($x > 1) {last;}
97 #    next;
98 #} continue {
99 #    if ($x++ > 10) {last;}
100 #    next;
101 #}
102 #
103 #if ($x < 10) {print "ok 10\n";} else {print "not ok 10\n";}
104
105 $i = 9;
106 {
107     $i++;
108 }
109 print "ok $i\n";
110
111 # Check curpm is reset when jumping out of a scope
112 'abc' =~ /b/;
113 WHILE:
114 while (1) {
115   $i++;
116   print "#$`,$&,$',\nnot " unless $` . $& . $' eq "abc";
117   print "ok $i\n";
118   {                             # Localize changes to $` and friends
119     'end' =~ /end/;
120     redo WHILE if $i == 11;
121     next WHILE if $i == 12;
122     # 13 do a normal loop
123     last WHILE if $i == 14;
124   }
125 }
126 $i++;
127 print "not " unless $` . $& . $' eq "abc";
128 print "ok $i\n";
129
130 # check that scope cleanup happens right when there's a continue block
131 {
132     my $var = 16;
133     while (my $i = ++$var) {
134         next if $i == 17;
135         last if $i > 17;
136         my $i = 0;
137     }
138     continue {
139         print "ok ", $var-1, "\nok $i\n";
140     }
141 }
142
143 {
144     local $l = 18;
145     {
146         local $l = 0
147     }
148     continue {
149         print "ok $l\n"
150     }
151 }
152
153 {
154     local $l = 19;
155     my $x = 0;
156     while (!$x++) {
157         local $l = 0
158     }
159     continue {
160         print "ok $l\n"
161     }
162 }
163
164 $i = 20;
165 {
166     while (1) {
167         my $x;
168         print $x if defined $x;
169         $x = "not ";
170         print "ok $i\n"; ++$i;
171         if ($i == 21) {
172             next;
173         }
174         last;
175     }
176     continue {
177         print "ok $i\n"; ++$i;
178     }
179 }