make die reliably hand error to post-eval code

Put the exception into $@ last thing before longjmping to the op following
the eval block, where previously it went into $@ before unwinding the
stack.  This change means that the exception is not liable to be lost
by $@ being clobbered by destructors, cleanup code, or restoration after
"local $@".  The code running immediately after eval can now rely on $@
accurately indicating the exception status of the eval.

2 files changed, 83 insertions, 0 deletions

diff --git a/t/op/die_except.t b/t/op/die_except.t
new file mode 100644
index 0000000000..b0fcadb8c8
--- /dev/null
+++ b/t/op/die_except.t
@@ -0,0 +1,81 @@
+#!./perl
+
+print "1..12\n";
+my $test_num = 0;
+sub ok {
+    print $_[0] ? "" : "not ", "ok ", ++$test_num, "\n";
+}
+
+{
+    package End;
+    sub DESTROY { $_[0]->() }
+    sub main::end(&) {
+	my($cleanup) = @_;
+	return bless(sub { $cleanup->() }, "End");
+    }
+}
+
+my($val, $err);
+
+$@ = "t0\n";
+$val = eval {
+	$@ = "t1\n";
+	1;
+}; $err = $@;
+ok $val == 1;
+ok $err eq "";
+
+$@ = "t0\n";
+$val = eval {
+	$@ = "t1\n";
+	do {
+		die "t3\n";
+	};
+	1;
+}; $err = $@;
+ok !defined($val);
+ok $err eq "t3\n";
+
+$@ = "t0\n";
+$val = eval {
+	$@ = "t1\n";
+	local $@ = "t2\n";
+	1;
+}; $err = $@;
+ok $val == 1;
+ok $err eq "";
+
+$@ = "t0\n";
+$val = eval {
+	$@ = "t1\n";
+	local $@ = "t2\n";
+	do {
+		die "t3\n";
+	};
+	1;
+}; $err = $@;
+ok !defined($val);
+ok $err eq "t3\n";
+
+$@ = "t0\n";
+$val = eval {
+	$@ = "t1\n";
+	my $c = end { $@ = "t2\n"; };
+	1;
+}; $err = $@;
+ok $val == 1;
+ok $err eq "";
+
+$@ = "t0\n";
+$val = eval {
+	$@ = "t1\n";
+	my $c = end { $@ = "t2\n"; };
+	do {
+		die "t3\n";
+	};
+	1;
+}; $err = $@;
+ok !defined($val);
+ok $err eq "t3\n";
+
+1;
diff --git a/t/op/eval.t b/t/op/eval.t
index 98fbc1e51c..ff5004eae5 100644
--- a/t/op/eval.t
+++ b/t/op/eval.t
@@ -526,6 +526,8 @@ if (eval "use Devel::Peek; 1;") {
         my $in = <IN>;
         my ($first, $second) = split (/\*\*\*\*\*\*\n/, $in, 2);
         $first =~ s/,pNOK//;
+        s/ PV = 0x[0-9a-f]+/ PV = 0x/ foreach $first, $second;
+        s/ LEN = [0-9]+/ LEN = / foreach $first, $second;
         $ok = 1 if ($first eq $second);
       }
     }