X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=GHC%2FHandle.hs;h=16a9a2fc9f31e1ea5289d8c153eedbfe4a20feff;hb=00de4ab6cf86f437091fe5d8038bd5382dca364b;hp=56deea63b77d9b7b20565c4ce81e5fd3018caa82;hpb=7e5e86a30f1d25bd2df79c6757f0c8dac4d18048;p=ghc-base.git

diff --git a/GHC/Handle.hs b/GHC/Handle.hs
index 56deea6..16a9a2f 100644
--- a/GHC/Handle.hs
+++ b/GHC/Handle.hs
@@ -1,4 +1,4 @@
-{-# OPTIONS -fno-implicit-prelude -#include "HsBase.h" #-}
+{-# OPTIONS_GHC -fno-implicit-prelude -#include "HsBase.h" #-}
 
 #undef DEBUG_DUMP
 #undef DEBUG
@@ -819,8 +819,10 @@ openFile' filepath mode binary =
 	-- (so we don't need to worry about removing the newly created file
 	--  in the event of an error).
 #ifndef mingw32_TARGET_OS
-    throwErrnoIf (/=0) "openFile" 
-       (c_ftruncate (fromIntegral fd) 0)
+    if mode == WriteMode
+      then throwErrnoIf (/=0) "openFile" 
+              (c_ftruncate (fromIntegral fd) 0)
+      else return 0
 #endif
     return h
 
@@ -1037,11 +1039,9 @@ hClose_handle_ handle_ = do
         c_fd = fromIntegral fd
 
     -- 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.
+    -- side of a duplex handle.
     case haOtherSide handle_ of
       Nothing -> 
-  	  when (fd /= fd_stdin && fd /= fd_stdout && fd /= fd_stderr) $
   		  throwErrnoIfMinus1Retry_ "hClose" 
 #ifdef mingw32_TARGET_OS
 	    			(closeFd (haIsStream handle_) c_fd)