From ad2d99e390e75f36bbfc104614c4b9e4c22fe450 Mon Sep 17 00:00:00 2001
From: Father Chrysostomos <sprout@cpan.org>
Date: Sat, 14 Jan 2012 00:23:23 -0800
Subject: [PATCH] -T "unreadable file" should set stat info consistently

This was mentioned in ticket #77388.  It turns out to be
related to #4253.

If the file cannot be opened, -T and -B on filenames set the last han-
dle to null and set the last stat type to stat, but leave the actual
stat buffer and success status as they were.

That means that stat(_) will continue to return the previous buffer,
but lstat(_) will no longer work.

This is another of those inconsistent cases where the internal stat
info is only partially set.

Originally, this code would set PL_laststatval (the success status) to
-1.  Commit 25988e07 (the patch in ticket #4253) intentionally changed
this to make -T _ less suprising on read-only files.

But the patch ended up affecting -T with an explicit file name, too.
It also only partially fixed things for -T _, because the last stat
type *was* still being set.

This commit changes it to set all the stat info, for explicit file
names, or no stat info, for _ (if the previous stat was with a
file name).
---
 pp_sys.c        |  6 +++++-
 t/op/filetest.t | 10 +++++++++-
 t/op/stat.t     |  5 ++++-
 3 files changed, 18 insertions(+), 3 deletions(-)

diff --git a/pp_sys.c b/pp_sys.c
index 88e2f4e..d748693 100644
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -3372,13 +3372,17 @@ PP(pp_fttext)
 	sv_setpv(PL_statname, SvPV_nomg_const_nolen(sv));
       really_filename:
 	PL_statgv = NULL;
-	PL_laststype = OP_STAT;
 	if (!(fp = PerlIO_open(SvPVX_const(PL_statname), "r"))) {
+	    if (!gv) {
+		PL_laststatval = -1;
+		PL_laststype = OP_STAT;
+	    }
 	    if (ckWARN(WARN_NEWLINE) && strchr(SvPV_nolen_const(PL_statname),
 					       '\n'))
 		Perl_warner(aTHX_ packWARN(WARN_NEWLINE), PL_warn_nl, "open");
 	    RETPUSHUNDEF;
 	}
+	PL_laststype = OP_STAT;
 	PL_laststatval = PerlLIO_fstat(PerlIO_fileno(fp), &PL_statcache);
 	if (PL_laststatval < 0)	{
 	    (void)PerlIO_close(fp);
diff --git a/t/op/filetest.t b/t/op/filetest.t
index a0a3ced..cdd76cc 100644
--- a/t/op/filetest.t
+++ b/t/op/filetest.t
@@ -10,7 +10,7 @@ BEGIN {
 }
 
 use Config;
-plan(tests => 46 + 27*14);
+plan(tests => 47 + 27*14);
 
 ok( -d 'op' );
 ok( -f 'TEST' );
@@ -320,6 +320,14 @@ SKIP: {
 is runperl(prog => '-T _', switches => ['-w'], stderr => 1), "",
   'no uninit warnings from -T with no preceding stat';
 
+SKIP: {
+    my $rand_file_name = 'filetest-' . rand =~ y/.//cdr;
+    if (-e $rand_file_name) { skip "File $rand_file_name exists", 1 }
+    stat 'test.pl';
+    -T $rand_file_name;
+    ok !stat _, '-T "nonexistent" resets stat success status';
+}
+
 # Unsuccessful filetests on filehandles should leave stat buffers in the
 # same state whether fatal warnings are on or off.
 {
diff --git a/t/op/stat.t b/t/op/stat.t
index e6bdc40..dfc00b9 100644
--- a/t/op/stat.t
+++ b/t/op/stat.t
@@ -20,7 +20,7 @@ if(eval {require File::Spec; 1}) {
 }
 
 
-plan tests => 110;
+plan tests => 111;
 
 my $Perl = which_perl();
 
@@ -513,6 +513,9 @@ SKIP: {
     -T _;
     my $s2 = -s _;
     is($s1, $s2, q(-T _ doesn't break the statbuffer));
+    lstat($tmpfile);
+    -T _;
+    ok(eval { lstat _ }, q(-T _ doesn't break lstat for unreadable file));
     unlink $tmpfile;
 }
 
-- 
2.7.4