Perl_op_sibling_splice(0 remove dead code
[perl.git] / t / op / die_unwind.t
1 #!./perl -w
2
3 chdir 't' if -d 't';
4 require './test.pl';
5 use strict;
6
7 #
8 # This test checks for $@ being set early during an exceptional
9 # unwinding, and that this early setting does not affect the late
10 # setting used to emit the exception from eval{}.  The early setting is
11 # a backward-compatibility hack to satisfy modules that were relying on
12 # the historical early setting in order to detect exceptional unwinding.
13 # This hack should be removed when a proper way to detect exceptional
14 # unwinding has been developed.
15 #
16
17 {
18     package End;
19     sub DESTROY { $_[0]->() }
20     sub main::end(&) {
21         my($cleanup) = @_;
22         return bless(sub { $cleanup->() }, "End");
23     }
24 }
25
26 my($uerr, $val, $err);
27
28 $@ = "";
29 $val = eval {
30         my $c = end { $uerr = $@; $@ = "t2\n"; };
31         1;
32 }; $err = $@;
33 is($uerr, "", "\$@ false at start of 'end' block inside 'eval' block");
34 is($val, 1, "successful return from 'eval' block");
35 is($err, "", "\$@ still false after 'end' block inside 'eval' block");
36
37 $@ = "t0\n";
38 $val = eval {
39         $@ = "t1\n";
40         my $c = end { $uerr = $@; $@ = "t2\n"; };
41         1;
42 }; $err = $@;
43 is($uerr, "t1\n", "true value assigned to \$@ before 'end' block inside 'eval' block");
44 is($val, 1, "successful return from 'eval' block");
45 is($err, "", "\$@ still false after 'end' block inside 'eval' block");
46
47 $@ = "";
48 $val = eval {
49         my $c = end { $uerr = $@; $@ = "t2\n"; };
50         do {
51                 die "t3\n";
52         };
53         1;
54 }; $err = $@;
55 is($uerr, "t3\n");
56 is($val, undef, "undefined return value from 'eval' block with 'die'");
57 is($err, "t3\n");
58
59 $@ = "t0\n";
60 $val = eval {
61         $@ = "t1\n";
62         my $c = end { $uerr = $@; $@ = "t2\n"; };
63         do {
64                 die "t3\n";
65         };
66         1;
67 }; $err = $@;
68 is($uerr, "t3\n");
69 is($val, undef, "undefined return value from 'eval' block with 'die'");
70 is($err, "t3\n");
71
72 done_testing();