X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=GHC%2FIO%2FHandle%2FInternals.hs;h=7ac0f551dcf54bb05065f0962a2c2e19aecb26e8;hb=4966da6b84e60869c917ffcc4ac8245c37b37b8f;hp=d1b5ab6f3dbabbcabab55f7d6af82c2dd1236565;hpb=e79405706953d969676526d751426f260efacac1;p=ghc-base.git

diff --git a/GHC/IO/Handle/Internals.hs b/GHC/IO/Handle/Internals.hs
index d1b5ab6..7ac0f55 100644
--- 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)
@@ -58,7 +59,7 @@ import GHC.IO.Device (IODevice, SeekMode(..))
 import qualified GHC.IO.Device as IODevice
 import qualified GHC.IO.BufferedIO as Buffered
 
-import GHC.Conc
+import GHC.Conc.Sync
 import GHC.Real
 import GHC.Base
 import GHC.Exception
@@ -69,7 +70,7 @@ import GHC.MVar
 import Data.Typeable
 import Control.Monad
 import Data.Maybe
-import Foreign
+import Foreign hiding (unsafePerformIO)
 -- import System.IO.Error
 import System.Posix.Internals hiding (FD)
 
@@ -123,7 +124,7 @@ withHandle fun h@(DuplexHandle _ m _) act = withHandle' fun h m act
 withHandle' :: String -> Handle -> MVar Handle__
    -> (Handle__ -> IO (Handle__,a)) -> IO a
 withHandle' fun h m act =
- block $ do
+ mask_ $ do
    (h',v)  <- do_operation fun h act m
    checkHandleInvariants h'
    putMVar m h'
@@ -148,7 +149,7 @@ withAllHandles__ fun h@(DuplexHandle _ r w) act = do
 withHandle__' :: String -> Handle -> MVar Handle__ -> (Handle__ -> IO Handle__)
               -> IO ()
 withHandle__' fun h m act =
- block $ do
+ mask_ $ do
    h'  <- do_operation fun h act m
    checkHandleInvariants h'
    putMVar m h'
@@ -359,18 +360,25 @@ ioe_bufsiz n = ioException
 -- has become unreferenced and then resurrected (arguably in the
 -- latter case we shouldn't finalize the Handle...).  Anyway,
 -- we try to emit a helpful message which is better than nothing.
+--
+-- [later; 8/2010] However, a program like this can yield a strange
+-- error message:
+--
+--   main = writeFile "out" loop
+--   loop = let x = x in x
+--
+-- because the main thread and the Handle are both unreachable at the
+-- same time, the Handle may get finalized before the main thread
+-- receives the NonTermination exception, and the exception handler
+-- will then report an error.  We'd rather this was not an error and
+-- the program just prints "<<loop>>".
 
 handleFinalizer :: FilePath -> MVar Handle__ -> IO ()
 handleFinalizer fp m = do
   handle_ <- takeMVar m
-  case haType handle_ of
-      ClosedHandle -> return ()
-      _ -> do flushWriteBuffer handle_ `catchAny` \_ -> return ()
-                -- ignore errors and async exceptions, and close the
-                -- descriptor anyway...
-              _ <- hClose_handle_ handle_
-              return ()
-  putMVar m (ioe_finalizedHandle fp)
+  (handle_', _) <- hClose_help handle_
+  putMVar m handle_'
+  return ()
 
 -- ---------------------------------------------------------------------------
 -- Allocating buffers
@@ -582,7 +590,7 @@ mkFileHandle dev filepath iomode mb_codec tr_newlines = do
 
 -- | like 'mkFileHandle', except that a 'Handle' is created with two
 -- independent buffers, one for reading and one for writing.  Used for
--- full-dupliex streams, such as network sockets.
+-- full-duplex streams, such as network sockets.
 mkDuplexHandle :: (IODevice dev, BufferedIO dev, Typeable dev) => dev
                -> FilePath -> Maybe TextEncoding -> NewlineMode -> IO Handle
 mkDuplexHandle dev filepath mb_codec tr_newlines = do
@@ -631,6 +639,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 +669,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 +688,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 +834,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'