4 ## Many of these tests are originally from Michael Schroeder
5 ## <Michael.Schroeder@informatik.uni-erlangen.de>
6 ## Adapted and expanded by Gurusamy Sarathy <gsar@activestate.com>
15 run_multiple_progs('', \*DATA);
22 @a = sort { last ; } @a;
25 Can't "last" outside a loop block at - line 3.
35 print "still in fetch\n";
44 - >test at (eval 1) line 1.
76 print STDERR "PRINT CALLED\n";
77 (split(/./, 'x'x10000))[0];
78 eval('die("test\n")');
86 print STDERR "DONE\n";
93 eval('die("foooo\n")');
95 $SIG{'__WARN__'} = 'warnhook';
109 eval('die("test\n")');
115 $bar = bless {}, TEST;
123 $a <=> $b unless eval('$a == 0 ? bless undef : ($a <=> $b)');
127 print join(', ', @a)."\n";
132 goto bar if $a == 0 || $b == 0;
137 print join(', ', @a)."\n";
140 print "bar reached\n";
142 Can't "goto" out of a pseudo block at - line 2.
146 (split(/./, 'x'x10000))[0];
147 my (@y) = ( 4, 6, 5);
148 @y = sort { $a <=> $b } @y;
149 my $t = "sortfn ".join(', ', @y)."\n";
150 print $t if ($seen{$t}++ == 0);
151 return $_[0] <=> $_[1];
154 @x = sort { &sortfn($a, $b) } @x;
155 print "---- ".join(', ', @x)."\n";
161 @a = sort { eval('die("no way")') , $a <=> $b} @a;
162 print join(", ", @a)."\n";
169 @a = sort { last foo; } @a;
172 Label not found for "last foo" at - line 4.
195 Can't "next" outside a loop block at - line 8.
216 Can't find label bbb at - line 8.
219 $a <=> $b unless eval('$a == 0 ? die("foo\n") : ($a <=> $b)');
223 print join(', ', @a)."\n";
236 (split(/./, 'x'x10000))[0];
253 Can't "next" outside a loop block at - line 4.
258 @a = sort { exit(0) } @a;
260 END { print "foobar\n" }
264 $SIG{__DIE__} = sub {
267 while (($p,$f,$l,$s) = caller(++$i)) {
268 print "$p|$f|$l|$s\n";
272 &{sub { eval 'die' }}();
273 sub foo { eval { die } } foo();
274 {package rmb; sub{ eval{die} } ->() }; # check __ANON__ knows package
280 main|-|9|main::__ANON__
286 rmb|-|11|rmb::__ANON__
291 return bless [qw(foo fee fie foe)], $_[0];
304 print join('|', @bar[0..3]), "\n";
309 sub TIEHASH { bless {}, TH }
310 sub STORE { eval { print "@_[1,2]\n" }; die "bar\n" }
312 eval { $h{A} = 1; print "never\n"; };
323 sub f { my $x = shift; d(); }
329 while (do { { package DB; @a = caller($i++) } } ) {
331 for (@a) { print "$_\n"; $_ = '' }
337 sub TIEHANDLE { bless {} }
344 Can't "next" outside a loop block at - line 2.
346 sub TIEHANDLE { bless {} }
347 sub PRINT { print "[TIE] $_[1]" }
355 sub TIEHANDLE { bless {} }
357 (split(/./, 'x'x10000))[0];
358 eval('die("test\n")');
361 open OLDERR, '>&STDERR';
364 use warnings FATAL => qw(uninitialized);
368 [TIE] Use of uninitialized value in print at - line 11.