From 71d2bbf7bca2d446fd6b0d2af97b6d1833314f7f Mon Sep 17 00:00:00 2001 From: Bryan O'Sullivan Date: Sat, 27 Nov 2010 18:18:26 +0000 Subject: [PATCH] Fix #4533 - unregister callbacks on exception, fixing a memory leak Our problem here was that if a thread blocked in threadWait or threadDelay and was killed by an exception thrown from another thread, its registration with the IO manager would not be cleared. The fix is simply to install exception handlers that do the cleanup and propagate the exception. --- System/Event/Thread.hs | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) diff --git a/System/Event/Thread.hs b/System/Event/Thread.hs index 990bae3..66174cd 100644 --- a/System/Event/Thread.hs +++ b/System/Event/Thread.hs @@ -10,6 +10,7 @@ module System.Event.Thread , registerDelay ) where +import Control.Exception (SomeException, catch, throw) import Data.IORef (IORef, newIORef, readIORef, writeIORef) import Data.Maybe (Maybe(..)) import Foreign.C.Error (eBADF, errnoToIOError) @@ -38,8 +39,9 @@ threadDelay :: Int -> IO () threadDelay usecs = do Just mgr <- readIORef eventManager m <- newEmptyMVar - _ <- registerTimeout mgr usecs (putMVar m ()) - takeMVar m + reg <- registerTimeout mgr usecs (putMVar m ()) + takeMVar m `catch` \(e::SomeException) -> + M.unregisterTimeout mgr reg >> throw e -- | Set the value of returned TVar to True after a given number of -- microseconds. The caveats associated with threadDelay also apply. @@ -85,8 +87,9 @@ threadWait :: Event -> Fd -> IO () threadWait evt fd = do m <- newEmptyMVar Just mgr <- readIORef eventManager - _ <- registerFd mgr (\reg e -> unregisterFd_ mgr reg >> putMVar m e) fd evt - evt' <- takeMVar m + reg <- registerFd mgr (\reg e -> unregisterFd_ mgr reg >> putMVar m e) fd evt + evt' <- takeMVar m `catch` \(e::SomeException) -> + unregisterFd_ mgr reg >> throw e if evt' `eventIs` evtClose then ioError $ errnoToIOError "threadWait" eBADF Nothing Nothing else return () -- 1.7.10.4