From: Jan Dubois <jand@activestate.com>
Date: Wed, 16 Dec 2009 23:42:19 +0000 (-0800)
Subject: -t should only return TRUE for file handles connected to a TTY
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=827da6a38269ebe059fe8acab0772f00c88704bf;p=p5sagit%2Fp5-mst-13.2.git

-t should only return TRUE for file handles connected to a TTY

The Microsoft C version of isatty() returns TRUE for all
character mode devices, including the /dev/null style "nul"
device and printers like "lpt1".

The included test has only been tested on Windows and Linux;
the device names for OS/2 and VMS are just best guesses...
---

diff --git a/MANIFEST b/MANIFEST
index ae5ce73..1bf5fbe 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -4389,6 +4389,7 @@ t/op/exists_sub.t		See if exists(&sub) works
 t/op/exp.t			See if math functions work
 t/op/fh.t			See if filehandles work
 t/op/filetest.t			See if file tests work
+t/op/filetest_t.t		See if -t file test works
 t/op/flip.t			See if range operator works
 t/op/fork.t			See if fork works
 t/op/getpid.t			See if $$ and getppid work with threads
diff --git a/t/op/filetest_t.t b/t/op/filetest_t.t
new file mode 100755
index 0000000..47e0387
--- /dev/null
+++ b/t/op/filetest_t.t
@@ -0,0 +1,26 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+    require './test.pl';
+}
+
+use strict;
+
+plan 2;
+
+my($dev_tty, $dev_null) = qw(/dev/tty /dev/null);
+  ($dev_tty, $dev_null) = qw(con      nul      ) if $^O =~ /^(MSWin32|os2)$/;
+  ($dev_tty, $dev_null) = qw(TT:      _NLA0:   ) if $^O eq "VMS";
+
+SKIP: {
+    open(my $tty, "<", $dev_tty)
+	or skip("Can't open terminal '$dev_tty': $!");
+    ok(-t $tty);
+}
+SKIP: {
+    open(my $null, "<", $dev_null)
+	or skip("Can't open null device '$dev_null': $!");
+    ok(!-t $null);
+}
diff --git a/win32/perlhost.h b/win32/perlhost.h
index 7464c7a..36a716a 100644
--- a/win32/perlhost.h
+++ b/win32/perlhost.h
@@ -1004,7 +1004,22 @@ PerlLIOIOCtl(struct IPerlLIO* piPerl, int i, unsigned int u, char *data)
 int
 PerlLIOIsatty(struct IPerlLIO* piPerl, int fd)
 {
-    return isatty(fd);
+    /* The Microsoft isatty() function returns true for *all*
+     * character mode devices, including "nul".  Our implementation
+     * should only return true if the handle has a console buffer.
+     */
+    DWORD mode;
+    HANDLE fh = (HANDLE)_get_osfhandle(fd);
+    if (fh == (HANDLE)-1) {
+        /* errno is already set to EBADF */
+        return 0;
+    }
+
+    if (GetConsoleMode(fh, &mode))
+        return 1;
+
+    errno = ENOTTY;
+    return 0;
 }
 
 int