From 2ad48547234bdf521daff432b65a0b173efd2a19 Mon Sep 17 00:00:00 2001
From: Father Chrysostomos <sprout@cpan.org>
Date: Sat, 14 Jan 2012 00:07:46 -0800
Subject: [PATCH] Make -T BADHANDLE set errno with fatal warnings
MIME-Version: 1.0
Content-Type: text/plain; charset=utf8
Content-Transfer-Encoding: 8bit

Due to the order of the statements, SETERRNO would never be reached
with fatal warnings.

I’ve added another SETERRNO out of paranoia.  If there is a nicely-
behaved __WARN__ handler, we should still be setting errno just before
-T returns, in case the handler changed it.  We can’t do much in
the case of fatal handlers that do system calls.  (Is $! localised
for those?)
---
 pp_sys.c        |  1 +
 t/op/filetest.t | 14 ++++++++++++--
 2 files changed, 13 insertions(+), 2 deletions(-)

diff --git a/pp_sys.c b/pp_sys.c
index 3757401..7767764 100644
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -3359,6 +3359,7 @@ PP(pp_fttext)
 		len = 512;
 	}
 	else {
+	    SETERRNO(EBADF,RMS_IFI);
 	    report_evil_fh(gv);
 	    SETERRNO(EBADF,RMS_IFI);
 	    RETPUSHUNDEF;
diff --git a/t/op/filetest.t b/t/op/filetest.t
index 86ad235..a0a3ced 100644
--- a/t/op/filetest.t
+++ b/t/op/filetest.t
@@ -10,7 +10,7 @@ BEGIN {
 }
 
 use Config;
-plan(tests => 45 + 27*14);
+plan(tests => 46 + 27*14);
 
 ok( -d 'op' );
 ok( -f 'TEST' );
@@ -259,7 +259,7 @@ ok !stat _,
 my $Perl = which_perl();
 
 SKIP: {
-    skip "no -T on filehandles", 7 unless eval { -T STDERR; 1 };
+    skip "no -T on filehandles", 8 unless eval { -T STDERR; 1 };
 
     # Test that -T HANDLE sets the last stat type
     -l "perl.c";   # last stat type is now lstat
@@ -305,6 +305,16 @@ SKIP: {
     eval { lstat _ };
     like $@, qr/^The stat preceding lstat\(\) wasn't an lstat at /,
 	'-T on closed handle resets last stat type';
+
+    # Fatal warnings should not affect the setting of errno.
+    $! = 7;
+    -T cradd;
+    my $errno = $!;
+    $! = 7;
+    eval { use warnings FATAL => unopened; -T cradd };
+    my $errno2 = $!;
+    is $errno2, $errno,
+	'fatal warnings do not affect errno after -T BADHADNLE';
 }
 
 is runperl(prog => '-T _', switches => ['-w'], stderr => 1), "",
-- 
2.7.4