[commit: unix] master: Move openPseudoTerminal into System.Posix.Terminal{.ByteString} (c8fada0)

[Simon Marlow]

Repository : ssh://darcs.haskell.org//srv/darcs/packages/unix

On branch  : master

http://hackage.haskell.org/trac/ghc/changeset/c8fada0d863085b8ac10f4d1f578e6428215ac28

>---------------------------------------------------------------

commit c8fada0d863085b8ac10f4d1f578e6428215ac28
Author: Simon Marlow <marlowsd at gmail.com>
Date:   Wed Nov 23 09:35:29 2011 +0000

    Move openPseudoTerminal into System.Posix.Terminal{.ByteString}
    
    It may depend on getSlaveTerminalName if !defined(HAVE_OPENPTY)

>---------------------------------------------------------------

 System/Posix/Terminal.hsc            |   61 ++++++++++++++++++++++++++++++++++
 System/Posix/Terminal/ByteString.hsc |   60 +++++++++++++++++++++++++++++++++
 System/Posix/Terminal/Common.hsc     |   61 +---------------------------------
 3 files changed, 122 insertions(+), 60 deletions(-)

diff --git a/System/Posix/Terminal.hsc b/System/Posix/Terminal.hsc
index 0a2866a..5657662 100644
--- a/System/Posix/Terminal.hsc
+++ b/System/Posix/Terminal.hsc
@@ -141,3 +141,64 @@ getSlaveTerminalName _ =
     ioError (errnoToIOError "getSlaveTerminalName" eNOSYS Nothing Nothing)
 #endif
 
+-- -----------------------------------------------------------------------------
+-- openPseudoTerminal needs to be here because it depends on
+-- getSlaveTerminalName.
+
+-- | @openPseudoTerminal@ creates a pseudoterminal (pty) pair, and
+-- returns the newly created pair as a (@master@, @slave@) tuple.
+openPseudoTerminal :: IO (Fd, Fd)
+
+#ifdef HAVE_OPENPTY
+openPseudoTerminal =
+  alloca $ \p_master ->
+    alloca $ \p_slave -> do
+      throwErrnoIfMinus1_ "openPty"
+          (c_openpty p_master p_slave nullPtr nullPtr nullPtr)
+      master <- peek p_master
+      slave <- peek p_slave
+      return (Fd master, Fd slave)
+
+foreign import ccall unsafe "openpty"
+  c_openpty :: Ptr CInt -> Ptr CInt -> CString -> Ptr CTermios -> Ptr a
+            -> IO CInt
+#else
+openPseudoTerminal = do
+  (Fd master) <- openFd "/dev/ptmx" ReadWrite Nothing
+                        defaultFileFlags{noctty=True}
+  throwErrnoIfMinus1_ "openPseudoTerminal" (c_grantpt master)
+  throwErrnoIfMinus1_ "openPseudoTerminal" (c_unlockpt master)
+  slaveName <- getSlaveTerminalName (Fd master)
+  slave <- openFd slaveName ReadWrite Nothing defaultFileFlags{noctty=True}
+  pushModule slave "ptem"
+  pushModule slave "ldterm"
+# ifndef __hpux
+  pushModule slave "ttcompat"
+# endif /* __hpux */
+  return (Fd master, slave)
+
+-- Push a STREAMS module, for System V systems.
+pushModule :: Fd -> String -> IO ()
+pushModule (Fd fd) name =
+  withCString name $ \p_name ->
+    throwErrnoIfMinus1_ "openPseudoTerminal"
+                        (c_push_module fd p_name)
+
+foreign import ccall unsafe "__hsunix_push_module"
+  c_push_module :: CInt -> CString -> IO CInt
+
+#ifdef HAVE_PTSNAME
+foreign import ccall unsafe "__hsunix_grantpt"
+  c_grantpt :: CInt -> IO CInt
+
+foreign import ccall unsafe "__hsunix_unlockpt"
+  c_unlockpt :: CInt -> IO CInt
+#else
+c_grantpt :: CInt -> IO CInt
+c_grantpt _ = return (fromIntegral 0)
+
+c_unlockpt :: CInt -> IO CInt
+c_unlockpt _ = return (fromIntegral 0)
+#endif /* HAVE_PTSNAME */
+#endif /* !HAVE_OPENPTY */
+
diff --git a/System/Posix/Terminal/ByteString.hsc b/System/Posix/Terminal/ByteString.hsc
index b3ca9a9..a75c37a 100644
--- a/System/Posix/Terminal/ByteString.hsc
+++ b/System/Posix/Terminal/ByteString.hsc
@@ -130,3 +130,63 @@ getSlaveTerminalName _ =
     ioError (errnoToIOError "getSlaveTerminalName" eNOSYS Nothing Nothing)
 #endif
 
+-- -----------------------------------------------------------------------------
+-- openPseudoTerminal needs to be here because it depends on
+-- getSlaveTerminalName.
+
+-- | @openPseudoTerminal@ creates a pseudoterminal (pty) pair, and
+-- returns the newly created pair as a (@master@, @slave@) tuple.
+openPseudoTerminal :: IO (Fd, Fd)
+
+#ifdef HAVE_OPENPTY
+openPseudoTerminal =
+  alloca $ \p_master ->
+    alloca $ \p_slave -> do
+      throwErrnoIfMinus1_ "openPty"
+          (c_openpty p_master p_slave nullPtr nullPtr nullPtr)
+      master <- peek p_master
+      slave <- peek p_slave
+      return (Fd master, Fd slave)
+
+foreign import ccall unsafe "openpty"
+  c_openpty :: Ptr CInt -> Ptr CInt -> CString -> Ptr CTermios -> Ptr a
+            -> IO CInt
+#else
+openPseudoTerminal = do
+  (Fd master) <- openFd "/dev/ptmx" ReadWrite Nothing
+                        defaultFileFlags{noctty=True}
+  throwErrnoIfMinus1_ "openPseudoTerminal" (c_grantpt master)
+  throwErrnoIfMinus1_ "openPseudoTerminal" (c_unlockpt master)
+  slaveName <- getSlaveTerminalName (Fd master)
+  slave <- openFd slaveName ReadWrite Nothing defaultFileFlags{noctty=True}
+  pushModule slave "ptem"
+  pushModule slave "ldterm"
+# ifndef __hpux
+  pushModule slave "ttcompat"
+# endif /* __hpux */
+  return (Fd master, slave)
+
+-- Push a STREAMS module, for System V systems.
+pushModule :: Fd -> String -> IO ()
+pushModule (Fd fd) name =
+  withCString name $ \p_name ->
+    throwErrnoIfMinus1_ "openPseudoTerminal"
+                        (c_push_module fd p_name)
+
+foreign import ccall unsafe "__hsunix_push_module"
+  c_push_module :: CInt -> CString -> IO CInt
+
+#ifdef HAVE_PTSNAME
+foreign import ccall unsafe "__hsunix_grantpt"
+  c_grantpt :: CInt -> IO CInt
+
+foreign import ccall unsafe "__hsunix_unlockpt"
+  c_unlockpt :: CInt -> IO CInt
+#else
+c_grantpt :: CInt -> IO CInt
+c_grantpt _ = return (fromIntegral 0)
+
+c_unlockpt :: CInt -> IO CInt
+c_unlockpt _ = return (fromIntegral 0)
+#endif /* HAVE_PTSNAME */
+#endif /* !HAVE_OPENPTY */
diff --git a/System/Posix/Terminal/Common.hsc b/System/Posix/Terminal/Common.hsc
index 39a2e30..3a6254d 100644
--- a/System/Posix/Terminal/Common.hsc
+++ b/System/Posix/Terminal/Common.hsc
@@ -26,6 +26,7 @@ module System.Posix.Terminal.Common (
   TerminalState(..),
   setTerminalAttributes,
 
+  CTermios,
   TerminalMode(..),
   withoutMode,
   withMode,
@@ -63,9 +64,6 @@ module System.Posix.Terminal.Common (
 
   -- ** Testing a file descriptor
   queryTerminal,
-
-  -- ** Pseudoterminal operations
-  openPseudoTerminal,
   ) where
 
 #include "HsUnix.h"
@@ -504,63 +502,6 @@ queryTerminal (Fd fd) = do
 foreign import ccall unsafe "isatty"
   c_isatty :: CInt -> IO CInt
 
--- | @openPseudoTerminal@ creates a pseudoterminal (pty) pair, and
--- returns the newly created pair as a (@master@, @slave@) tuple.
-openPseudoTerminal :: IO (Fd, Fd)
-
-#ifdef HAVE_OPENPTY
-openPseudoTerminal =
-  alloca $ \p_master ->
-    alloca $ \p_slave -> do
-      throwErrnoIfMinus1_ "openPty"
-          (c_openpty p_master p_slave nullPtr nullPtr nullPtr)
-      master <- peek p_master
-      slave <- peek p_slave
-      return (Fd master, Fd slave)
-
-foreign import ccall unsafe "openpty"
-  c_openpty :: Ptr CInt -> Ptr CInt -> CString -> Ptr CTermios -> Ptr a
-            -> IO CInt
-#else
-openPseudoTerminal = do
-  (Fd master) <- openFd "/dev/ptmx" ReadWrite Nothing
-                        defaultFileFlags{noctty=True}
-  throwErrnoIfMinus1_ "openPseudoTerminal" (c_grantpt master)
-  throwErrnoIfMinus1_ "openPseudoTerminal" (c_unlockpt master)
-  slaveName <- getSlaveTerminalName (Fd master)
-  slave <- openFd slaveName ReadWrite Nothing defaultFileFlags{noctty=True}
-  pushModule slave "ptem"
-  pushModule slave "ldterm"
-# ifndef __hpux
-  pushModule slave "ttcompat"
-# endif /* __hpux */
-  return (Fd master, slave)
-
--- Push a STREAMS module, for System V systems.
-pushModule :: Fd -> String -> IO ()
-pushModule (Fd fd) name =
-  withCString name $ \p_name ->
-    throwErrnoIfMinus1_ "openPseudoTerminal"
-                        (c_push_module fd p_name)
-
-foreign import ccall unsafe "__hsunix_push_module"
-  c_push_module :: CInt -> CString -> IO CInt
-
-#ifdef HAVE_PTSNAME
-foreign import ccall unsafe "__hsunix_grantpt"
-  c_grantpt :: CInt -> IO CInt
-
-foreign import ccall unsafe "__hsunix_unlockpt"
-  c_unlockpt :: CInt -> IO CInt
-#else
-c_grantpt :: CInt -> IO CInt
-c_grantpt _ = return (fromIntegral 0)
-
-c_unlockpt :: CInt -> IO CInt
-c_unlockpt _ = return (fromIntegral 0)
-#endif /* HAVE_PTSNAME */
-#endif /* !HAVE_OPENPTY */
-
 -- -----------------------------------------------------------------------------
 -- Local utility functions