Skip to content
Snippets Groups Projects
Commit 9b7fe933 authored by Malcolm.Wallace@cs.york.ac.uk's avatar Malcolm.Wallace@cs.york.ac.uk
Browse files

Temporarily fix breakage for nhc98.

A recent patch to System.IO introduced a cyclic dependency on Foreign.C.Error,
and also inadvertently dragged along System.Posix.Internals which has
non-H'98 layout, causing many build problems.  The solution for now
is to #ifndef __NHC__ all of the recent the openTempFile additions,
and mark them non-portable once again.  (I also took the opportunity
to note a number of other non-portable functions in their Haddock
comments.)
parent b8acf99d
No related branches found
No related tags found
No related merge requests found
...@@ -95,7 +95,7 @@ module System.IO ( ...@@ -95,7 +95,7 @@ module System.IO (
hIsReadable, hIsWritable, -- :: Handle -> IO Bool hIsReadable, hIsWritable, -- :: Handle -> IO Bool
hIsSeekable, -- :: Handle -> IO Bool hIsSeekable, -- :: Handle -> IO Bool
-- ** Terminal operations -- ** Terminal operations (not portable: ghc/hugs only)
#if !defined(__NHC__) #if !defined(__NHC__)
hIsTerminalDevice, -- :: Handle -> IO Bool hIsTerminalDevice, -- :: Handle -> IO Bool
...@@ -104,7 +104,7 @@ module System.IO ( ...@@ -104,7 +104,7 @@ module System.IO (
hGetEcho, -- :: Handle -> IO Bool hGetEcho, -- :: Handle -> IO Bool
#endif #endif
-- ** Showing handle state -- ** Showing handle state (not portable: ghc only)
#ifdef __GLASGOW_HASKELL__ #ifdef __GLASGOW_HASKELL__
hShow, -- :: Handle -> IO String hShow, -- :: Handle -> IO String
...@@ -155,18 +155,22 @@ module System.IO ( ...@@ -155,18 +155,22 @@ module System.IO (
hGetBufNonBlocking, -- :: Handle -> Ptr a -> Int -> IO Int hGetBufNonBlocking, -- :: Handle -> Ptr a -> Int -> IO Int
#endif #endif
-- * Temporary files -- * Temporary files (not portable: ghc/hugs only)
#if !defined(__NHC__)
openTempFile, openTempFile,
openBinaryTempFile, openBinaryTempFile,
#endif
) where ) where
#ifndef __NHC__
import Data.Bits import Data.Bits
import Data.List import Data.List
import Data.Maybe import Data.Maybe
import Foreign.C.Error import Foreign.C.Error
import Foreign.C.String import Foreign.C.String
import System.Posix.Internals import System.Posix.Internals
#endif
#ifdef __GLASGOW_HASKELL__ #ifdef __GLASGOW_HASKELL__
import GHC.Exception as ExceptionBase hiding (catch) import GHC.Exception as ExceptionBase hiding (catch)
...@@ -412,6 +416,7 @@ openBinaryFile = openFile ...@@ -412,6 +416,7 @@ openBinaryFile = openFile
hSetBinaryMode _ _ = return () hSetBinaryMode _ _ = return ()
#endif #endif
#ifndef __NHC__
-- | The function creates a temporary file in ReadWrite mode. -- | The function creates a temporary file in ReadWrite mode.
-- The created file isn\'t deleted automatically, so you need to delete it manually. -- The created file isn\'t deleted automatically, so you need to delete it manually.
openTempFile :: FilePath -- ^ Directory in which to create the file openTempFile :: FilePath -- ^ Directory in which to create the file
...@@ -483,6 +488,7 @@ read_flags = std_flags .|. o_RDONLY ...@@ -483,6 +488,7 @@ read_flags = std_flags .|. o_RDONLY
write_flags = output_flags .|. o_WRONLY write_flags = output_flags .|. o_WRONLY
rw_flags = output_flags .|. o_RDWR rw_flags = output_flags .|. o_RDWR
append_flags = write_flags .|. o_APPEND append_flags = write_flags .|. o_APPEND
#endif
-- $locking -- $locking
-- Implementations should enforce as far as possible, at least locally to the -- Implementations should enforce as far as possible, at least locally to the
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment