Add tests from testsuite/tests/h98

[ghc-base.git] / System / Posix / Internals.hs

diff --git a/System/Posix/Internals.hs b/System/Posix/Internals.hs
index ca0253e..6a30ba0 100644 (file)
--- a/System/Posix/Internals.hs
+++ b/System/Posix/Internals.hs
@@ -1,5 +1,4 @@
-{-# OPTIONS_GHC -XNoImplicitPrelude #-}
-{-# OPTIONS_GHC -fno-warn-unused-binds #-}
+{-# LANGUAGE CPP, NoImplicitPrelude, ForeignFunctionInterface #-}
 {-# OPTIONS_HADDOCK hide #-}
 
 -----------------------------------------------------------------------------
@@ -52,6 +51,10 @@ import GHC.IO
 import GHC.IO.IOMode
 import GHC.IO.Exception
 import GHC.IO.Device
+#ifndef mingw32_HOST_OS
+import {-# SOURCE #-} GHC.IO.Encoding (fileSystemEncoding)
+import qualified GHC.Foreign as GHC
+#endif
 #elif __HUGS__
 import Hugs.Prelude (IOException(..), IOErrorType(..))
 import Hugs.IO (IOMode(..))
@@ -66,6 +69,18 @@ import DIOError
 {-# CFILES cbits/PrelIOUtils.c cbits/consUtils.c #-}
 #endif
 
+
+-- ---------------------------------------------------------------------------
+-- Debugging the base package
+
+puts :: String -> IO ()
+puts s = withCAStringLen (s ++ "\n") $ \(p, len) -> do
+            -- In reality should be withCString, but assume ASCII to avoid loop
+            -- if this is called by GHC.Foreign
+           _ <- c_write 1 (castPtr p) (fromIntegral len)
+           return ()
+
+
 -- ---------------------------------------------------------------------------
 -- Types
 
@@ -172,10 +187,26 @@ fdGetMode fd = do
 
 #ifdef mingw32_HOST_OS
 withFilePath :: FilePath -> (CWString -> IO a) -> IO a
-withFilePath = withCWString 
+withFilePath = withCWString
+
+peekFilePath :: CWString -> IO FilePath
+peekFilePath = peekCWString
 #else
+
 withFilePath :: FilePath -> (CString -> IO a) -> IO a
+peekFilePath :: CString -> IO FilePath
+peekFilePathLen :: CStringLen -> IO FilePath
+
+#if __GLASGOW_HASKELL__
+withFilePath = GHC.withCString fileSystemEncoding
+peekFilePath = GHC.peekCString fileSystemEncoding
+peekFilePathLen = GHC.peekCStringLen fileSystemEncoding
+#else
 withFilePath = withCString
+peekFilePath = peekCString
+peekFilePathLen = peekCStringLen
+#endif
+
 #endif
 
 -- ---------------------------------------------------------------------------
@@ -311,6 +342,9 @@ foreign import ccall unsafe "consUtils.h set_console_echo__"
 foreign import ccall unsafe "consUtils.h get_console_echo__"
    get_console_echo :: CInt -> IO CInt
 
+foreign import ccall unsafe "consUtils.h is_console__"
+   is_console :: CInt -> IO CInt
+
 #endif
 
 -- ---------------------------------------------------------------------------
@@ -321,14 +355,14 @@ setNonBlockingFD :: FD -> Bool -> IO ()
 setNonBlockingFD fd set = do
   flags <- throwErrnoIfMinus1Retry "setNonBlockingFD"
                  (c_fcntl_read fd const_f_getfl)
-  -- An error when setting O_NONBLOCK isn't fatal: on some systems 
-  -- there are certain file handles on which this will fail (eg. /dev/null
-  -- on FreeBSD) so we throw away the return code from fcntl_write.
   let flags' | set       = flags .|. o_NONBLOCK
              | otherwise = flags .&. complement o_NONBLOCK
   unless (flags == flags') $ do
-    throwErrnoIfMinus1Retry_ "fcntl_write" $
-        c_fcntl_write fd const_f_setfl (fromIntegral flags')
+    -- An error when setting O_NONBLOCK isn't fatal: on some systems
+    -- there are certain file handles on which this will fail (eg. /dev/null
+    -- on FreeBSD) so we throw away the return code from fcntl_write.
+    _ <- c_fcntl_write fd const_f_setfl (fromIntegral flags')
+    return ()
 #else
 
 -- bogus defns for win32
@@ -390,16 +424,19 @@ foreign import ccall unsafe "HsBase.h __hscore_lseek"
 foreign import ccall unsafe "HsBase.h __hscore_lstat"
    lstat :: CFilePath -> Ptr CStat -> IO CInt
 
-foreign import ccall unsafe "__hscore_open"
+foreign import ccall unsafe "HsBase.h __hscore_open"
    c_open :: CFilePath -> CInt -> CMode -> IO CInt
 
+foreign import ccall safe "HsBase.h __hscore_open"
+   c_safe_open :: CFilePath -> CInt -> CMode -> IO CInt
+
 foreign import ccall unsafe "HsBase.h read" 
    c_read :: CInt -> Ptr Word8 -> CSize -> IO CSsize
 
-foreign import ccall safe "read"
+foreign import ccall safe "HsBase.h read"
    c_safe_read :: CInt -> Ptr Word8 -> CSize -> IO CSsize
 
-foreign import ccall unsafe "__hscore_stat"
+foreign import ccall unsafe "HsBase.h __hscore_stat"
    c_stat :: CFilePath -> Ptr CStat -> IO CInt
 
 foreign import ccall unsafe "HsBase.h umask"
@@ -408,7 +445,7 @@ foreign import ccall unsafe "HsBase.h umask"
 foreign import ccall unsafe "HsBase.h write" 
    c_write :: CInt -> Ptr Word8 -> CSize -> IO CSsize
 
-foreign import ccall safe "write"
+foreign import ccall safe "HsBase.h write"
    c_safe_write :: CInt -> Ptr Word8 -> CSize -> IO CSsize
 
 foreign import ccall unsafe "HsBase.h __hscore_ftruncate"
@@ -457,7 +494,7 @@ foreign import ccall unsafe "HsBase.h tcgetattr"
 foreign import ccall unsafe "HsBase.h tcsetattr"
    c_tcsetattr :: CInt -> CInt -> Ptr CTermios -> IO CInt
 
-foreign import ccall unsafe "HsBase.h utime"
+foreign import ccall unsafe "HsBase.h __hscore_utime"
    c_utime :: CString -> Ptr CUtimbuf -> IO CInt
 
 foreign import ccall unsafe "HsBase.h waitpid"