[project @ 2002-02-12 11:44:54 by simonmar]

[ghc-hetmet.git] / ghc / lib / std / PrelHandle.hs

diff --git a/ghc/lib/std/PrelHandle.hs b/ghc/lib/std/PrelHandle.hs
index 0e9286c..fe360a7 100644 (file)
--- a/ghc/lib/std/PrelHandle.hs
+++ b/ghc/lib/std/PrelHandle.hs
@@ -4,7 +4,7 @@
 #undef DEBUG
 
 -- -----------------------------------------------------------------------------
--- $Id: PrelHandle.hs,v 1.7 2001/12/27 09:28:10 sof Exp $
+-- $Id: PrelHandle.hs,v 1.9 2002/01/28 13:47:05 simonmar Exp $
 --
 -- (c) The University of Glasgow, 1994-2001
 --
@@ -594,7 +594,7 @@ openFile' filepath ex_mode =
               | otherwise         = False
 
       binary_flags
-         | binary    = PrelHandle.o_BINARY -- is '0' if not supported.
+         | binary    = o_BINARY -- is '0' if not supported.
          | otherwise = 0
 
       oflags = oflags1 .|. binary_flags
@@ -768,17 +768,22 @@ hClose_help handle_ =
   case haType handle_ of 
       ClosedHandle -> return handle_
       _ -> do
-         let fd = fromIntegral (haFD handle_)
+         let fd = haFD handle_
+             c_fd = fromIntegral fd
+
          flushWriteBufferOnly handle_
 
-         -- close the file descriptor, but not when this is the read side
-         -- of a duplex handle.
+         -- close the file descriptor, but not when this is the read
+         -- side of a duplex handle, and not when this is one of the
+         -- std file handles.
          case haOtherSide handle_ of
-           Nothing -> throwErrnoIfMinus1Retry_ "hClose" 
+           Nothing -> 
+               when (fd /= fd_stdin && fd /= fd_stdout && fd /= fd_stderr) $
+                       throwErrnoIfMinus1Retry_ "hClose" 
 #ifdef mingw32_TARGET_OS
-                                               (closeFd (haIsStream handle_) fd)
+                               (closeFd (haIsStream handle_) c_fd)
 #else
-                                               (c_close fd)
+                               (c_close c_fd)
 #endif
            Just _  -> return ()
 
@@ -786,7 +791,7 @@ hClose_help handle_ =
          writeIORef (haBuffers handle_) BufferListNil
 
          -- unlock it
-         unlockFile fd
+         unlockFile c_fd
 
          -- we must set the fd to -1, because the finalizer is going
          -- to run eventually and try to close/unlock it.
@@ -1217,6 +1222,5 @@ foreign import ccall "prel_bufsiz"   unsafe dEFAULT_BUFFER_SIZE :: Int
 foreign import ccall "prel_seek_cur" unsafe sEEK_CUR :: CInt
 foreign import ccall "prel_seek_set" unsafe sEEK_SET :: CInt
 foreign import ccall "prel_seek_end" unsafe sEEK_END :: CInt
-foreign import ccall "prel_o_binary" unsafe o_BINARY :: CInt