7 # This test checks for $@ being set early during an exceptional
8 # unwinding, and that this early setting does not affect the late
9 # setting used to emit the exception from eval{}. The early setting is
10 # a backward-compatibility hack to satisfy modules that were relying on
11 # the historical early setting in order to detect exceptional unwinding.
12 # This hack should be removed when a proper way to detect exceptional
13 # unwinding has been developed.
18 sub DESTROY { $_[0]->() }
21 return bless(sub { $cleanup->() }, "End");
25 my($uerr, $val, $err);
29 my $c = end { $uerr = $@; $@ = "t2\n"; };
32 is($uerr, "", "\$@ false at start of 'end' block inside 'eval' block");
33 is($val, 1, "successful return from 'eval' block");
34 is($err, "", "\$@ still false after 'end' block inside 'eval' block");
39 my $c = end { $uerr = $@; $@ = "t2\n"; };
42 is($uerr, "t1\n", "true value assigned to \$@ before 'end' block inside 'eval' block");
43 is($val, 1, "successful return from 'eval' block");
44 is($err, "", "\$@ still false after 'end' block inside 'eval' block");
48 my $c = end { $uerr = $@; $@ = "t2\n"; };
55 is($val, undef, "undefined return value from 'eval' block with 'die'");
61 my $c = end { $uerr = $@; $@ = "t2\n"; };
68 is($val, undef, "undefined return value from 'eval' block with 'die'");