Fix a few places where we forgot to close the text codecs (#4029)

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

diff --git a/GHC/IO/Handle/Internals.hs b/GHC/IO/Handle/Internals.hs
index d1b5ab6..2c0523f 100644 (file)
--- a/GHC/IO/Handle/Internals.hs
+++ b/GHC/IO/Handle/Internals.hs
@@ -28,13 +28,14 @@ module GHC.IO.Handle.Internals (
   wantSeekableHandle,
 
   mkHandle, mkFileHandle, mkDuplexHandle,
-  openTextEncoding, initBufferState,
+  openTextEncoding, closeTextCodecs, initBufferState,
   dEFAULT_CHAR_BUFFER_SIZE,
 
   flushBuffer, flushWriteBuffer, flushWriteBuffer_, flushCharReadBuffer,
   flushCharBuffer, flushByteReadBuffer,
 
   readTextDevice, writeTextDevice, readTextDeviceNonBlocking,
+  decodeByteBuf,
 
   augmentIOError,
   ioe_closedHandle, ioe_EOF, ioe_notReadable, ioe_notWritable,
@@ -49,7 +50,7 @@ module GHC.IO.Handle.Internals (
 
 import GHC.IO
 import GHC.IO.IOMode
-import GHC.IO.Encoding
+import GHC.IO.Encoding as Encoding
 import GHC.IO.Handle.Types
 import GHC.IO.Buffer
 import GHC.IO.BufferedIO (BufferedIO)
@@ -631,6 +632,11 @@ openTextEncoding (Just TextEncoding{..}) ha_type cont = do
                      return Nothing
     cont mb_encoder mb_decoder
 
+closeTextCodecs :: Handle__ -> IO ()
+closeTextCodecs Handle__{..} = do
+  case haDecoder of Nothing -> return (); Just d -> Encoding.close d
+  case haEncoder of Nothing -> return (); Just d -> Encoding.close d
+
 -- ---------------------------------------------------------------------------
 -- closing Handles
 
@@ -656,7 +662,7 @@ trymaybe :: IO () -> IO (Maybe SomeException)
 trymaybe io = (do io; return Nothing) `catchException` \e -> return (Just e)
 
 hClose_handle_ :: Handle__ -> IO (Handle__, Maybe SomeException)
-hClose_handle_ Handle__{..} = do
+hClose_handle_ h_@Handle__{..} = do
 
     -- close the file descriptor, but not when this is the read
     -- side of a duplex handle.
@@ -675,8 +681,7 @@ hClose_handle_ Handle__{..} = do
     writeIORef haByteBuffer noByteBuffer
   
     -- release our encoder/decoder
-    case haDecoder of Nothing -> return (); Just d -> close d
-    case haEncoder of Nothing -> return (); Just d -> close d
+    closeTextCodecs h_
 
     -- we must set the fd to -1, because the finalizer is going
     -- to run eventually and try to close/unlock it.
@@ -822,22 +827,28 @@ readTextDeviceNonBlocking :: Handle__ -> CharBuffer -> IO CharBuffer
 readTextDeviceNonBlocking h_@Handle__{..} cbuf = do
   --
   bbuf0 <- readIORef haByteBuffer
-  bbuf1 <- if not (isEmptyBuffer bbuf0)
-              then return bbuf0
-              else do
-                   (r,bbuf1) <- Buffered.fillReadBuffer0 haDevice bbuf0
-                   if isNothing r then ioe_EOF else do  -- raise EOF
-                   return bbuf1
+  when (isEmptyBuffer bbuf0) $ do
+     (r,bbuf1) <- Buffered.fillReadBuffer0 haDevice bbuf0
+     if isNothing r then ioe_EOF else do  -- raise EOF
+     writeIORef haByteBuffer bbuf1
+
+  decodeByteBuf h_ cbuf
+
+-- Decode bytes from the byte buffer into the supplied CharBuffer.
+decodeByteBuf :: Handle__ -> CharBuffer -> IO CharBuffer
+decodeByteBuf h_@Handle__{..} cbuf = do
+  --
+  bbuf0 <- readIORef haByteBuffer
 
   (bbuf2,cbuf') <-
       case haDecoder of
           Nothing      -> do
-               writeIORef haLastDecode (error "codec_state", bbuf1)
-               latin1_decode bbuf1 cbuf
+               writeIORef haLastDecode (error "codec_state", bbuf0)
+               latin1_decode bbuf0 cbuf
           Just decoder -> do
                state <- getState decoder
-               writeIORef haLastDecode (state, bbuf1)
-               (encode decoder) bbuf1 cbuf
+               writeIORef haLastDecode (state, bbuf0)
+               (encode decoder) bbuf0 cbuf
 
   writeIORef haByteBuffer bbuf2
   return cbuf'