From cbd58baf5927dd469f38f80a7c76c8011150b6c5 Mon Sep 17 00:00:00 2001
From: Zefram <zefram@fysh.org>
Date: Thu, 29 Aug 2013 22:00:07 +0100
Subject: [PATCH] preserve $! and $^E in Carp

Carp::longmess and Carp::shortmess now explicitly localise these status
variables, for the reason described in the new paragraph of documentation.
---
 MANIFEST              |  1 +
 dist/Carp/lib/Carp.pm |  9 +++++++
 dist/Carp/t/errno.t   | 71 +++++++++++++++++++++++++++++++++++++++++++++++++++
 3 files changed, 81 insertions(+)
 create mode 100644 dist/Carp/t/errno.t

diff --git a/MANIFEST b/MANIFEST
index 4c01447..90f563e 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -2990,6 +2990,7 @@ dist/Carp/t/baduni.t		See if Carp handles non-char Unicode
 dist/Carp/t/baduni_warnings.t		See if Carp handles non-char Unicode when loaded via warnings.pm
 dist/Carp/t/Carp_overload.t		See if Carp handles overloads
 dist/Carp/t/Carp.t		See if Carp works
+dist/Carp/t/errno.t		See if Carp preserves $! and $^E
 dist/Carp/t/heavy_mismatch.t		See if Carp::Heavy catches version mismatch
 dist/Carp/t/heavy.t		See if Carp::Heavy works
 dist/Carp/t/stash_deletion.t		See if Carp handles stash deletion
diff --git a/dist/Carp/lib/Carp.pm b/dist/Carp/lib/Carp.pm
index 324d3e7..0eab7a8 100644
--- a/dist/Carp/lib/Carp.pm
+++ b/dist/Carp/lib/Carp.pm
@@ -134,6 +134,7 @@ sub _cgc {
 }
 
 sub longmess {
+    local($!, $^E);
     # Icky backwards compatibility wrapper. :-(
     #
     # The story is that the original implementation hard-coded the
@@ -154,6 +155,7 @@ sub longmess {
 our @CARP_NOT;
 
 sub shortmess {
+    local($!, $^E);
     my $cgc = _cgc();
 
     # Icky backwards compatibility wrapper. :-(
@@ -615,6 +617,13 @@ error as being from where your module was called.  C<shortmess()> returns the
 contents of this error message.  There is no guarantee that that is where the
 error was, but it is a good educated guess.
 
+C<Carp> takes care not to clobber the status variables C<$!> and C<$^E>
+in the course of assembling its error messages.  This means that a
+C<$SIG{__DIE__}> or C<$SIG{__WARN__}> handler can capture the error
+information held in those variables, if it is required to augment the
+error message, and if the code calling C<Carp> left useful values there.
+Of course, C<Carp> can't guarantee the latter.
+
 You can also alter the way the output and logic of C<Carp> works, by
 changing some global variables in the C<Carp> namespace. See the
 section on C<GLOBAL VARIABLES> below.
diff --git a/dist/Carp/t/errno.t b/dist/Carp/t/errno.t
new file mode 100644
index 0000000..2d2db46
--- /dev/null
+++ b/dist/Carp/t/errno.t
@@ -0,0 +1,71 @@
+use warnings;
+use strict;
+
+use Test::More tests => 20;
+
+use Carp ();
+
+sub AA::CARP_TRACE { $! = 42; $^E = 42; "Tracy" }
+my $aa = bless({}, "AA");
+
+my($m, $errno, $exterr);
+
+$! = 69; $^E = 69;
+sub lmm { Carp::longmess("x") }
+sub lm { lmm() }
+$m = lm($aa);
+$errno = 0+$!; $exterr = 0+$^E;
+like $m, qr/Tracy/;
+is $errno, 69;
+is $exterr, 69;
+
+$! = 69; $^E = 69;
+sub sm { Carp::shortmess("x") }
+$m = sm($aa);
+$errno = 0+$!; $exterr = 0+$^E;
+like $m, qr/Tracy/;
+is $errno, 69;
+is $exterr, 69;
+
+$SIG{__WARN__} = sub { $m = $_[0]; $errno = 0+$!; $exterr = 0+$^E; };
+
+$! = 69; $^E = 69;
+$m = $errno = $exterr = undef;
+sub cl { Carp::cluck("x") }
+cl($aa);
+like $m, qr/Tracy/;
+is $errno, 69;
+is $exterr, 69;
+
+$! = 69; $^E = 69;
+$m = $errno = $exterr = undef;
+sub cp { Carp::carp("x") }
+cp($aa);
+like $m, qr/Tracy/;
+is $errno, 69;
+is $exterr, 69;
+
+$SIG{__DIE__} = $SIG{__WARN__};
+delete $SIG{__WARN__};
+
+$! = 69; $^E = 69;
+$m = $errno = $exterr = undef;
+sub cf { Carp::confess("x") }
+eval { cf($aa) };
+like $@, qr/Tracy/;
+like $m, qr/Tracy/;
+is $errno, 69;
+is $exterr, 69;
+
+$! = 69; $^E = 69;
+$m = $errno = $exterr = undef;
+sub ck { Carp::croak("x") }
+eval { ck($aa) };
+like $@, qr/Tracy/;
+like $m, qr/Tracy/;
+is $errno, 69;
+is $exterr, 69;
+
+delete $SIG{__DIE__};
+
+1;
-- 
2.7.4