mktables: Omit unnecessary duplicates
[perl.git] / t / op / die_except.t
1 #!./perl -w
2
3 chdir 't' if -d 't';
4 require './test.pl';
5 use 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
16 my($val, $err);
17
18 $@ = "t0\n";
19 $val = eval {
20         $@ = "t1\n";
21         1;
22 }; $err = $@;
23 is($val, 1, "true return value from successful eval block");
24 is($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 = $@;
34 is($val, undef, "undefined return value from eval block with 'die'");
35 is($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 = $@;
43 is($val, 1, "true return value from successful eval block with localized \$@");
44 is($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 = $@;
55 is($val, undef,
56     "undefined return value from eval block with 'die' and localized \$@");
57 is($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 = $@;
66 is($val, 1, "true return value from eval block with 'end'");
67 is($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 = $@;
78 is($val, undef, "undefined return value from eval block with 'end' and 'die'");
79 is($err, "t3\n", "exception after eval block with 'end' and 'die'");
80
81 done_testing();