diff options
author | Father Chrysostomos <sprout@cpan.org> | 2012-01-14 00:23:23 -0800 |
---|---|---|
committer | Father Chrysostomos <sprout@cpan.org> | 2012-01-14 00:55:20 -0800 |
commit | ad2d99e390e75f36bbfc104614c4b9e4c22fe450 (patch) | |
tree | 5db20ce135c197290eb6e511bf448daf8c97373b | |
parent | 7b64ff23e735d414eea886bd2bf2b6231acbd7a2 (diff) | |
download | perl-ad2d99e390e75f36bbfc104614c4b9e4c22fe450.tar.gz |
-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).
-rw-r--r-- | pp_sys.c | 6 | ||||
-rw-r--r-- | t/op/filetest.t | 10 | ||||
-rw-r--r-- | t/op/stat.t | 5 |
3 files changed, 18 insertions, 3 deletions
@@ -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 a0a3cedd37..cdd76ccbcd 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 e6bdc405ad..dfc00b9045 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; } |