Commit | Line | Data |
---|---|---|
cbd22dec | 1 | #!./perl -w |
96d9b9cd | 2 | |
b5efbd1f | 3 | chdir 't' if -d 't'; |
cbd22dec NC |
4 | require './test.pl'; |
5 | use strict; | |
96d9b9cd Z |
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 = $@; | |
1e7893b6 JK |
23 | is($val, 1, "true return value from successful eval block"); |
24 | is($err, "", "no exception after successful eval block"); | |
96d9b9cd Z |
25 | |
26 | $@ = "t0\n"; | |
27 | $val = eval { | |
28 | $@ = "t1\n"; | |
29 | do { | |
30 | die "t3\n"; | |
31 | }; | |
32 | 1; | |
33 | }; $err = $@; | |
1e7893b6 JK |
34 | is($val, undef, "undefined return value from eval block with 'die'"); |
35 | is($err, "t3\n", "exception after eval block with 'die'"); | |
96d9b9cd Z |
36 | |
37 | $@ = "t0\n"; | |
38 | $val = eval { | |
39 | $@ = "t1\n"; | |
40 | local $@ = "t2\n"; | |
41 | 1; | |
42 | }; $err = $@; | |
1e7893b6 JK |
43 | is($val, 1, "true return value from successful eval block with localized \$@"); |
44 | is($err, "", "no exception after successful eval block with localized \$@"); | |
96d9b9cd Z |
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 = $@; | |
1e7893b6 JK |
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 \$@"); | |
96d9b9cd Z |
59 | |
60 | $@ = "t0\n"; | |
61 | $val = eval { | |
62 | $@ = "t1\n"; | |
63 | my $c = end { $@ = "t2\n"; }; | |
64 | 1; | |
65 | }; $err = $@; | |
1e7893b6 JK |
66 | is($val, 1, "true return value from eval block with 'end'"); |
67 | is($err, "", "no exception after eval block with 'end'"); | |
96d9b9cd Z |
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 = $@; | |
1e7893b6 JK |
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'"); | |
96d9b9cd | 80 | |
cbd22dec | 81 | done_testing(); |