X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Flib%2Fstd%2FPrelHandle.hs;h=fe360a713ad13df1bf1668173487b882f79191ef;hb=239e9471e104fd88ec93bf42623c3a68a496657a;hp=0e9286c0fca5e6e183c215359590126bccd9149b;hpb=215280e9692c0b2063b83342b0e900c8028a8eb7;p=ghc-hetmet.git

diff --git a/ghc/lib/std/PrelHandle.hs b/ghc/lib/std/PrelHandle.hs
index 0e9286c..fe360a7 100644
--- 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