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