[commit: packages/unix] master: Don't assume `tcdrain` and `ctermid` exist always (d17b03d)
git at git.haskell.org
git at git.haskell.org
Tue Apr 19 21:37:27 UTC 2016
Repository : ssh://git@git.haskell.org/unix
On branch : master
Link : http://ghc.haskell.org/trac/ghc/changeset/d17b03d4d4525103f1995441045eae4c2c73355d/unix
>---------------------------------------------------------------
commit d17b03d4d4525103f1995441045eae4c2c73355d
Author: Herbert Valerio Riedel <hvr at gnu.org>
Date: Sat Jan 30 16:46:56 2016 +0100
Don't assume `tcdrain` and `ctermid` exist always
This follows the scheme suggested in #24
This fixes #55
>---------------------------------------------------------------
d17b03d4d4525103f1995441045eae4c2c73355d
System/Posix/Terminal.hsc | 18 +++++++++++++++++-
System/Posix/Terminal/ByteString.hsc | 17 ++++++++++++++++-
System/Posix/Terminal/Common.hsc | 16 +++++++++++++++-
changelog.md | 4 +++-
configure.ac | 13 +++++++++++++
5 files changed, 64 insertions(+), 4 deletions(-)
diff --git a/System/Posix/Terminal.hsc b/System/Posix/Terminal.hsc
index c8335a6..88bd93f 100644
--- a/System/Posix/Terminal.hsc
+++ b/System/Posix/Terminal.hsc
@@ -1,3 +1,4 @@
+{-# LANGUAGE CApiFFI #-}
#if __GLASGOW_HASKELL__ >= 709
{-# LANGUAGE Safe #-}
#elif __GLASGOW_HASKELL__ >= 703
@@ -83,6 +84,11 @@ import System.Posix.IO
import System.Posix.Internals (peekFilePath)
+#if !HAVE_CTERMID
+import System.IO.Error ( ioeSetLocation )
+import GHC.IO.Exception ( unsupportedOperation )
+#endif
+
-- | @getTerminalName fd@ calls @ttyname@ to obtain a name associated
-- with the terminal for @Fd@ @fd at . If @fd@ is associated
-- with a terminal, @getTerminalName@ returns the name of the
@@ -100,13 +106,23 @@ foreign import ccall unsafe "ttyname"
-- controlling terminal exists,
-- @getControllingTerminalName@ returns the name of the
-- controlling terminal.
+--
+-- Throws 'IOError' (\"unsupported operation\") if platform does not
+-- provide @ctermid(3)@ (use @#if HAVE_CTERMID@ CPP guard to
+-- detect availability).
getControllingTerminalName :: IO FilePath
+#if HAVE_CTERMID
getControllingTerminalName = do
s <- throwErrnoIfNull "getControllingTerminalName" (c_ctermid nullPtr)
peekFilePath s
-foreign import ccall unsafe "ctermid"
+foreign import capi unsafe "termios.h ctermid"
c_ctermid :: CString -> IO CString
+#else
+{-# WARNING getControllingTerminalName
+ "operation will throw 'IOError' \"unsupported operation\" (CPP guard: @#if HAVE_CTERMID@)" #-}
+getControllingTerminalName = ioError (ioeSetLocation unsupportedOperation "getControllingTerminalName")
+#endif
-- | @getSlaveTerminalName@ calls @ptsname@ to obtain the name of the
-- slave terminal associated with a pseudoterminal pair. The file
diff --git a/System/Posix/Terminal/ByteString.hsc b/System/Posix/Terminal/ByteString.hsc
index fd44c85..3c7abfb 100644
--- a/System/Posix/Terminal/ByteString.hsc
+++ b/System/Posix/Terminal/ByteString.hsc
@@ -1,3 +1,4 @@
+{-# LANGUAGE CApiFFI #-}
#if __GLASGOW_HASKELL__ >= 709
{-# LANGUAGE Safe #-}
#elif __GLASGOW_HASKELL__ >= 703
@@ -91,6 +92,10 @@ import Foreign.C hiding (
import System.Posix.ByteString.FilePath
+#if !HAVE_CTERMID
+import System.IO.Error ( ioeSetLocation )
+import GHC.IO.Exception ( unsupportedOperation )
+#endif
-- | @getTerminalName fd@ calls @ttyname@ to obtain a name associated
-- with the terminal for @Fd@ @fd at . If @fd@ is associated
@@ -109,13 +114,23 @@ foreign import ccall unsafe "ttyname"
-- controlling terminal exists,
-- @getControllingTerminalName@ returns the name of the
-- controlling terminal.
+--
+-- Throws 'IOError' (\"unsupported operation\") if platform does not
+-- provide @ctermid(3)@ (use @#if HAVE_CTERMID@ CPP guard to
+-- detect availability).
getControllingTerminalName :: IO RawFilePath
+#if HAVE_CTERMID
getControllingTerminalName = do
s <- throwErrnoIfNull "getControllingTerminalName" (c_ctermid nullPtr)
peekFilePath s
-foreign import ccall unsafe "ctermid"
+foreign import capi unsafe "termios.h ctermid"
c_ctermid :: CString -> IO CString
+#else
+{-# WARNING getControllingTerminalName
+ "operation will throw 'IOError' \"unsupported operation\" (CPP guard: @#if HAVE_CTERMID@)" #-}
+getControllingTerminalName = ioError (ioeSetLocation unsupportedOperation "getControllingTerminalName")
+#endif
-- | @getSlaveTerminalName@ calls @ptsname@ to obtain the name of the
-- slave terminal associated with a pseudoterminal pair. The file
diff --git a/System/Posix/Terminal/Common.hsc b/System/Posix/Terminal/Common.hsc
index 49418f5..4825b10 100644
--- a/System/Posix/Terminal/Common.hsc
+++ b/System/Posix/Terminal/Common.hsc
@@ -78,6 +78,11 @@ import Foreign.Storable ( Storable(..) )
import System.IO.Unsafe ( unsafePerformIO )
import System.Posix.Types
+#if !HAVE_TCDRAIN
+import System.IO.Error ( ioeSetLocation )
+import GHC.IO.Exception ( unsupportedOperation )
+#endif
+
-- -----------------------------------------------------------------------------
-- Terminal attributes
@@ -408,12 +413,21 @@ foreign import capi unsafe "termios.h tcsendbreak"
-- | @drainOutput fd@ calls @tcdrain@ to block until all output
-- written to @Fd@ @fd@ has been transmitted.
+--
+-- Throws 'IOError' (\"unsupported operation\") if platform does not
+-- provide @tcdrain(3)@ (use @#if HAVE_TCDRAIN@ CPP guard to
+-- detect availability).
drainOutput :: Fd -> IO ()
+#if HAVE_TCDRAIN
drainOutput (Fd fd) = throwErrnoIfMinus1_ "drainOutput" (c_tcdrain fd)
foreign import capi unsafe "termios.h tcdrain"
c_tcdrain :: CInt -> IO CInt
-
+#else
+{-# WARNING drainOutput
+ "operation will throw 'IOError' \"unsupported operation\" (CPP guard: @#if HAVE_TCDRAIN@)" #-}
+drainOutput _ = ioError (ioeSetLocation unsupportedOperation "drainOutput")
+#endif
data QueueSelector
= InputQueue -- TCIFLUSH
diff --git a/changelog.md b/changelog.md
index e9c4ece..c6d6b69 100644
--- a/changelog.md
+++ b/changelog.md
@@ -4,7 +4,9 @@
* Don't assume non-POSIX `WCOREDUMP(x)` macro exists
- * Don't assume existence of termios constants beyond `B38400`
+ * Don't assume existence of `termios(3)` constants beyond `B38400`
+
+ * Don't assume existence of `ctermid(3)`/`tcdrain(3)`
* Turn build error into compile warnings for exotic `struct stat`
configurations (GHC #8859).
diff --git a/configure.ac b/configure.ac
index 24ea3a5..f883624 100644
--- a/configure.ac
+++ b/configure.ac
@@ -80,6 +80,19 @@ AC_CHECK_DECLS([fdatasync],[AC_CHECK_FUNCS([fdatasync])])
AC_CHECK_FUNCS([posix_fadvise posix_fallocate])
+# Some termios(3) functions known to be missing sometimes (see also #55)
+AC_CHECK_DECLS([tcdrain],[AC_DEFINE([HAVE_TCDRAIN],[1],[Define to 1 if you have the `tcdrain' function.])],[],[AC_INCLUDES_DEFAULT
+#ifdef HAVE_TERMIOS_H
+#include <termios.h>
+#endif
+])
+
+AC_CHECK_DECLS([ctermid],[AC_DEFINE([HAVE_CTERMID],[1],[Define to 1 if you have the `ctermid' function.])],[],[AC_INCLUDES_DEFAULT
+#ifdef HAVE_TERMIOS_H
+#include <termios.h>
+#endif
+])
+
# Avoid adding rt if absent or unneeded
# shm_open needs -lrt on linux
AC_SEARCH_LIBS(shm_open, rt, [AC_CHECK_FUNCS([shm_open shm_unlink])])
More information about the ghc-commits
mailing list