From: Simon Marlow <simonmar@microsoft.com>
Date: Thu, 28 Jun 2007 13:43:20 +0000 (+0000)
Subject: fix bug in writes to blocking FDs in the non-threaded RTS
X-Git-Tag: 2007-09-13~55
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=f11ef0c81fe851ae3d7b6cbd7be1264f03b475f8;p=ghc-base.git

fix bug in writes to blocking FDs in the non-threaded RTS
---

diff --git a/GHC/Handle.hs b/GHC/Handle.hs
index 7ae3fe6..261c81c 100644
--- a/GHC/Handle.hs
+++ b/GHC/Handle.hs
@@ -598,8 +598,9 @@ writeRawBuffer loc fd is_nonblock buf off len
   | is_nonblock = unsafe_write
   | threaded    = safe_write
   | otherwise   = do r <- fdReady (fromIntegral fd) 1 0 False
-                     if r /= 0 then safe_write
-                                else return 0
+                     if r /= 0 
+                        then safe_write
+                        else do threadWaitWrite (fromIntegral fd); unsafe_write
   where  
     do_write call = throwErrnoIfMinus1RetryMayBlock loc call
 		        (threadWaitWrite (fromIntegral fd)) 
@@ -611,8 +612,9 @@ writeRawBufferPtr loc fd is_nonblock buf off len
   | is_nonblock = unsafe_write
   | threaded    = safe_write
   | otherwise   = do r <- fdReady (fromIntegral fd) 1 0 False
-                     if r /= 0 then safe_write
-                                else return 0
+                     if r /= 0 
+                        then safe_write
+                        else do threadWaitWrite (fromIntegral fd); unsafe_write
   where
     do_write call = throwErrnoIfMinus1RetryMayBlock loc call
 		        (threadWaitWrite (fromIntegral fd))