This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
-t should only return TRUE for file handles connected to a TTY
authorJan Dubois <jand@activestate.com>
Wed, 16 Dec 2009 23:42:19 +0000 (15:42 -0800)
committerJan Dubois <jand@activestate.com>
Wed, 16 Dec 2009 23:46:34 +0000 (15:46 -0800)
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...

MANIFEST
t/op/filetest_t.t [new file with mode: 0755]
win32/perlhost.h

index ae5ce73..1bf5fbe 100644 (file)
--- 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 (executable)
index 0000000..47e0387
--- /dev/null
@@ -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);
+}
index 7464c7a..36a716a 100644 (file)
@@ -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