[project @ 2002-09-25 15:16:30 by simonpj]

[ghc-base.git] / GHC / Handle.hs

diff --git a/GHC/Handle.hs b/GHC/Handle.hs
index c927e13..43ef3d4 100644 (file)
--- a/GHC/Handle.hs
+++ b/GHC/Handle.hs
@@ -24,12 +24,12 @@ module GHC.Handle (
   newEmptyBuffer, allocateBuffer, readCharFromBuffer, writeCharIntoBuffer,
   flushWriteBufferOnly, flushWriteBuffer, flushReadBuffer, fillReadBuffer,
   read_off,  read_off_ba,
-  write_off, write_off_ba,
+  write_off, write_off_ba, unlockFile,
 
   ioe_closedHandle, ioe_EOF, ioe_notReadable, ioe_notWritable,
 
   stdin, stdout, stderr,
-  IOMode(..), IOModeEx(..), openFile, openFileEx, openFd,
+  IOMode(..), IOModeEx(..), openFile, openFileEx, openFd, fdToHandle,
   hFileSize, hIsEOF, isEOF, hLookAhead, hSetBuffering, hSetBinaryMode,
   hFlush, 
 
@@ -306,16 +306,23 @@ stdHandleFinalizer m = do
 handleFinalizer :: MVar Handle__ -> IO ()
 handleFinalizer m = do
   h_ <- takeMVar m
-  flushWriteBufferOnly h_
-  let fd = fromIntegral (haFD h_)
-  unlockFile fd
-  when (fd /= -1) 
+  let
+    -- hClose puts both the fd and the handle's type
+    -- into a closed state, so it's a bit excessive
+    -- to test for both here, but caution sometimes
+    -- pays off..
+   alreadyClosed = 
+     case haType h_ of { ClosedHandle{} -> True; _ -> False }
+   fd = fromIntegral (haFD h_)
+
+  when (not alreadyClosed && fd /= -1) $ do
+       flushWriteBufferOnly h_
+       unlockFile fd
 #ifdef mingw32_TARGET_OS
        (closeFd (haIsStream h_) fd >> return ())
 #else
        (c_close fd >> return ())
 #endif
-  return ()
 
 -- ---------------------------------------------------------------------------
 -- Grimy buffer operations
@@ -548,9 +555,6 @@ Two files are the same if they have the same absolute name.  An
 implementation is free to impose stricter conditions.
 -}
 
-data IOMode      =  ReadMode | WriteMode | AppendMode | ReadWriteMode
-                    deriving (Eq, Ord, Ix, Enum, Read, Show)
-
 data IOModeEx 
  = BinaryMode IOMode
  | TextMode   IOMode
@@ -667,6 +671,12 @@ openFd fd mb_fd_type filepath mode binary truncate = do
           mkFileHandle fd is_stream filepath ha_type binary
 
 
+fdToHandle :: FD -> IO Handle
+fdToHandle fd = do
+   mode <- fdGetMode fd
+   let fd_str = "<file descriptor: " ++ show fd ++ ">"
+   openFd fd Nothing fd_str mode True{-bin mode-} False{-no truncate-}
+
 foreign import ccall unsafe "lockFile"
   lockFile :: CInt -> CInt -> CInt -> IO CInt
 
@@ -1188,6 +1198,14 @@ hIsTerminalDevice handle = do
 -- -----------------------------------------------------------------------------
 -- hSetBinaryMode
 
+-- | On Windows, reading a file in text mode (which is the default) will
+-- translate CRLF to LF, and writing will translate LF to CRLF. This
+-- is usually what you want with text files. With binary files this is
+-- undesirable; also, as usual under Microsoft operating systems, text
+-- mode treats control-Z as EOF.  Setting binary mode using
+-- 'hSetBinaryMode' turns off all special treatment of end-of-line and
+-- end-of-file characters.
+--
 hSetBinaryMode :: Handle -> Bool -> IO ()
 hSetBinaryMode handle bin =
   withAllHandles__ "hSetBinaryMode" handle $ \ handle_ ->