X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=GHC%2FHandle.hs;h=49ab6dc020f5ed1e6cc428666237bd85252c5d36;hb=refs%2Ftags%2Farity-anal-branch-point;hp=f3008c437a636f097453b90d8ac4780125ca93f9;hpb=e225c624c6bc7099da8e2092d76563e43b7ba3f2;p=ghc-base.git

diff --git a/GHC/Handle.hs b/GHC/Handle.hs
index f3008c4..49ab6dc 100644
--- a/GHC/Handle.hs
+++ b/GHC/Handle.hs
@@ -813,15 +813,21 @@ openFile' filepath mode binary =
 	      throwErrnoIfMinus1Retry "openFile"
  	        (c_open f (fromIntegral oflags) 0o666)
 
-    h <- openFd fd Nothing False filepath mode binary
+    fd_type <- fdType fd
+
+    h <- openFd fd (Just fd_type) False filepath mode binary
             `catchException` \e -> do c_close (fromIntegral fd); throw e
 	-- NB. don't forget to close the FD if openFd fails, otherwise
 	-- this FD leaks.
 	-- ASSERT: if we just created the file, then openFd won't fail
 	-- (so we don't need to worry about removing the newly created file
 	--  in the event of an error).
+
 #ifndef mingw32_HOST_OS
-    if mode == WriteMode
+	-- we want to truncate() if this is an open in WriteMode, but only
+	-- if the target is a RegularFile.  ftruncate() fails on special files
+	-- like /dev/null.
+    if mode == WriteMode && fd_type == RegularFile
       then throwErrnoIf (/=0) "openFile" 
               (c_ftruncate (fromIntegral fd) 0)
       else return 0