xref: /openbsd/gnu/usr.bin/perl/t/op/die_except.t (revision 274d7c50) 
1#!./perl -w
2
3chdir 't' if -d 't';
4require './test.pl';
5use strict;
6
7{
8    package End;
9    sub DESTROY { $_[0]->() }
10    sub main::end(&) {
11	my($cleanup) = @_;
12	return bless(sub { $cleanup->() }, "End");
13    }
14}
15
16my($val, $err);
17
18$@ = "t0\n";
19$val = eval {
20	$@ = "t1\n";
21	1;
22}; $err = $@;
23is($val, 1, "true return value from successful eval block");
24is($err, "", "no exception after successful eval block");
25
26$@ = "t0\n";
27$val = eval {
28	$@ = "t1\n";
29	do {
30		die "t3\n";
31	};
32	1;
33}; $err = $@;
34is($val, undef, "undefined return value from eval block with 'die'");
35is($err, "t3\n", "exception after eval block with 'die'");
36
37$@ = "t0\n";
38$val = eval {
39	$@ = "t1\n";
40	local $@ = "t2\n";
41	1;
42}; $err = $@;
43is($val, 1, "true return value from successful eval block with localized \$@");
44is($err, "", "no exception after successful eval block with localized \$@");
45
46$@ = "t0\n";
47$val = eval {
48	$@ = "t1\n";
49	local $@ = "t2\n";
50	do {
51		die "t3\n";
52	};
53	1;
54}; $err = $@;
55is($val, undef,
56    "undefined return value from eval block with 'die' and localized \$@");
57is($err, "t3\n",
58    "exception after eval block with 'die' and localized \$@");
59
60$@ = "t0\n";
61$val = eval {
62	$@ = "t1\n";
63	my $c = end { $@ = "t2\n"; };
64	1;
65}; $err = $@;
66is($val, 1, "true return value from eval block with 'end'");
67is($err, "", "no exception after eval block with 'end'");
68
69$@ = "t0\n";
70$val = eval {
71	$@ = "t1\n";
72	my $c = end { $@ = "t2\n"; };
73	do {
74		die "t3\n";
75	};
76	1;
77}; $err = $@;
78is($val, undef, "undefined return value from eval block with 'end' and 'die'");
79is($err, "t3\n", "exception after eval block with 'end' and 'die'");
80
81done_testing();
82