don't fill a finalized handle with an error (see comment)

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

diff --git a/GHC/IO/Handle/Internals.hs b/GHC/IO/Handle/Internals.hs
index 5568855..7ac0f55 100644 (file)
--- a/GHC/IO/Handle/Internals.hs
+++ b/GHC/IO/Handle/Internals.hs
@@ -59,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
@@ -70,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)
 
@@ -360,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
@@ -583,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