Fix hWaitForInput

[ghc-base.git] / GHC / IO / Handle / Internals.hs

diff --git a/GHC/IO/Handle/Internals.hs b/GHC/IO/Handle/Internals.hs
index 0de07f4..a948b65 100644 (file)
--- a/GHC/IO/Handle/Internals.hs
+++ b/GHC/IO/Handle/Internals.hs
@@ -205,7 +205,8 @@ checkWritableHandle act h_@Handle__{..}
            buf <- readIORef haCharBuffer
            writeIORef haCharBuffer buf{ bufState = WriteBuffer }
            buf <- readIORef haByteBuffer
-           writeIORef haByteBuffer buf{ bufState = WriteBuffer }
+           buf' <- Buffered.emptyWriteBuffer haDevice buf
+           writeIORef haByteBuffer buf'
         act h_
       _other               -> act h_
 
@@ -679,7 +680,7 @@ hLookAhead_ handle_@Handle__{..} = do
 debugIO :: String -> IO ()
 #if defined(DEBUG_DUMP)
 debugIO s = do 
-  withCStringLen (s++"\n") $ \(p,len) -> c_write 1 p (fromIntegral len)
+  withCStringLen (s++"\n") $ \(p,len) -> c_write 1 (castPtr p) (fromIntegral len)
   return ()
 #else
 debugIO s = return ()
@@ -705,8 +706,8 @@ writeTextDevice h_@Handle__{..} cbuf = do
   debugIO ("writeTextDevice after encoding: cbuf=" ++ summaryBuffer cbuf' ++ 
         " bbuf=" ++ summaryBuffer bbuf')
 
-  Buffered.flushWriteBuffer haDevice bbuf'
-  writeIORef haByteBuffer bbuf{bufL=0,bufR=0}
+  bbuf' <- Buffered.flushWriteBuffer haDevice bbuf'
+  writeIORef haByteBuffer bbuf'
   if not (isEmptyBuffer cbuf')
      then writeTextDevice h_ cbuf'
      else return ()
@@ -792,13 +793,19 @@ readTextDeviceNonBlocking h_@Handle__{..} cbuf = do
   bbuf1 <- if not (isEmptyBuffer bbuf0)
               then return bbuf0
               else do
-                   (r,bbuf1) <- Buffered.fillReadBuffer haDevice bbuf0
-                   if r == 0 then ioe_EOF else do  -- raise EOF
+                   (r,bbuf1) <- Buffered.fillReadBuffer0 haDevice bbuf0
+                   if isNothing r then ioe_EOF else do  -- raise EOF
                    return bbuf1
 
-  (bbuf2,cbuf') <- case haDecoder of
-                     Nothing      -> latin1_decode bbuf1 cbuf
-                     Just decoder -> (encode decoder) bbuf1 cbuf
+  (bbuf2,cbuf') <-
+      case haDecoder of
+          Nothing      -> do
+               writeIORef haLastDecode (error "codec_state", bbuf1)
+               latin1_decode bbuf1 cbuf
+          Just decoder -> do
+               state <- getState decoder
+               writeIORef haLastDecode (state, bbuf1)
+               (encode decoder) bbuf1 cbuf
 
   writeIORef haByteBuffer bbuf2
   return cbuf'