11 my $tmpfile = tempfile();
12 open (tmp,'>', $tmpfile) || die "Can't create Cmd_while.tmp.";
18 close tmp or die "Could not close: $!";
22 open(fh, $tmpfile) || die "Can't open Cmd_while.tmp.";
31 open(fh, $tmpfile) || die "Can't open Cmd_while.tmp.";
36 ok(eof && !/vt100/ && !$bad);
41 open(fh,$tmpfile) || die "Can't open Cmd_while.tmp.";
43 if (s/vt100/VT100/g) {
52 # now do the same with a label and a continue block
57 open(fh,$tmpfile) || die "Can't open Cmd_while.tmp.";
59 if (/vt100/) {last line;}
61 $badcont = 1 if /vt100/;
70 open(fh,$tmpfile) || die "Can't open Cmd_while.tmp.";
72 next entry if /vt100/;
75 $badcont = '' if /vt100/;
77 ok(eof && !/vt100/ && !$bad);
84 open(fh,$tmpfile) || die "Can't open Cmd_while.tmp.";
86 if (s/vt100/VT100/g) {
93 $badcont = 1 if /vt100/;
98 close(fh) || die "Can't close Cmd_while.tmp.";
106 # Check curpm is reset when jumping out of a scope
112 is($` . $& . $', "abc");
113 { # Localize changes to $` and friends
115 redo WHILE if $i == 1;
116 next WHILE if $i == 2;
118 last WHILE if $i == 4;
121 is($` . $& . $', "abc");
123 # check that scope cleanup happens right when there's a continue block
126 my (@got_var, @got_i);
127 while (my $i = ++$var) {
133 ($got_var, $got_i) = ($var, $i);
169 $ok = 0 if defined $x;
181 sub save_context { $_[0] = wantarray; $_[1] }
188 save_context($context, "foo");
191 is(scalar($p->()), 0);
192 is($context, undef, "last statement in while block has 'void' context");
200 save_context($context, "foo");
203 is(scalar($p->()), "foo");
204 is($context, "", "last statement in block has 'scalar' context");
208 # test scope is cleaned
218 fresh_perl_is <<'72406', "foobar\n", {},
219 { package o; use overload bool => sub { die unless $::ok++; return 1 } }
220 use constant OK => bless [], o::;
221 do{print("foobar\n");}until OK;
223 "[perl #72406] segv with do{}until CONST where const is not folded";