Stop truncate(word) from falling back to file name

In commit 5e0adc2d66, which was a bug fix, I made the mistake of
checking the truth of the return value of gv_fetchsv, which is called
when truncate’s argument is a bareword.

This meant that truncate FOO, 0; would truncate the file named FOO if
the glob happened to have been deleted.

diff --git a/pp_sys.c b/pp_sys.c
index 76bd1ac..a17227d 100644 (file)
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -2215,9 +2215,9 @@ PP(pp_truncate)
        GV *tmpgv;
        IO *io;
 
-       if ((tmpgv = PL_op->op_flags & OPf_SPECIAL
-                      ? gv_fetchsv(sv, 0, SVt_PVIO)
-                      : MAYBE_DEREF_GV(sv) )) {
+       if (PL_op->op_flags & OPf_SPECIAL
+                      ? (tmpgv = gv_fetchsv(sv, 0, SVt_PVIO), 1)
+                      : !!(tmpgv = MAYBE_DEREF_GV(sv)) ) {
            io = GvIO(tmpgv);
            if (!io)
                result = 0;

diff --git a/t/io/fs.t b/t/io/fs.t
index 1cdddec..26208c1 100644 (file)
--- a/t/io/fs.t
+++ b/t/io/fs.t
@@ -46,7 +46,7 @@ $needs_fh_reopen = 1 if (defined &Win32::IsWin95 && Win32::IsWin95());
 my $skip_mode_checks =
     $^O eq 'cygwin' && $ENV{CYGWIN} !~ /ntsec/;
 
-plan tests => 51;
+plan tests => 52;
 
 my $tmpdir = tempfile();
 my $tmpdir1 = tempfile();
@@ -372,7 +372,7 @@ SKIP: {
 
     SKIP: {
         if ($^O eq 'vos') {
-           skip ("# TODO - hit VOS bug posix-973 - cannot resize an open file below the current file pos.", 5);
+           skip ("# TODO - hit VOS bug posix-973 - cannot resize an open file below the current file pos.", 6);
        }
 
        is(-s $tmpfile, 200, "fh resize to 200 working (filename check)");
@@ -407,6 +407,14 @@ SKIP: {
        is(-s $tmpfile, 100, "fh resize by IO slot working");
 
        close FH;
+
+       my $n = "for_fs_dot_t$$";
+       open FH, ">$n" or die "open $n: $!";
+       print FH "bloh blah bla\n";
+       close FH or die "close $n: $!";
+       eval "truncate $n, 0; 1" or die;
+       ok !-z $n, 'truncate(word) does not fall back to file name';
+       unlink $n;
     }
 }