diff options
author | Jochen Keil <jochen.keil@gmail.com> | 2012-08-14 20:34:05 +0200 |
---|---|---|
committer | Jochen Keil <jochen.keil@gmail.com> | 2012-08-14 20:34:05 +0200 |
commit | 81289a1382f901b11320130f8a9c07e593a468f3 (patch) | |
tree | 1534a4a16ffbb4f843eb4337a15d3b15f082d747 | |
parent | 6af9700dd0f7a4fd8b8ad0a302e52e8bfb3f2344 (diff) | |
download | xmobar-81289a1382f901b11320130f8a9c07e593a468f3.tar.gz xmobar-81289a1382f901b11320130f8a9c07e593a468f3.tar.bz2 |
Bugfix: Replace the TMVar String with a TVar (Maybe String)
The problem was a race condition which occured when running multiple
threads with a small timeout value. Then the TMVar could be left empty.
(e.g. hitting a key which causes an operation to write to the pipe very fast)
This meant that tryTakeTMVar would return Nothing which would cause all
subsequent reset threads to not call cb and keep a stale string on
display.
By using a Maybe String wrapped in a TVar there is always a valid value
available which can be used to restore the display (or not if it's
Nothing, but that's desired then and not because another thread was
scheduled earlier).
-rw-r--r-- | src/Plugins/BufferedPipeReader.hs | 13 |
1 files changed, 7 insertions, 6 deletions
diff --git a/src/Plugins/BufferedPipeReader.hs b/src/Plugins/BufferedPipeReader.hs index be6a652..04512e4 100644 --- a/src/Plugins/BufferedPipeReader.hs +++ b/src/Plugins/BufferedPipeReader.hs @@ -42,10 +42,10 @@ instance Exec BufferedPipeReader where writer chan str rst where - initV :: IO ( TChan (Int, Bool, String), TMVar String, TVar Bool ) + initV :: IO ( TChan (Int, Bool, String), TVar (Maybe String), TVar Bool ) initV = atomically $ do tc <- newTChan - ts <- newEmptyTMVar + ts <- newTVar Nothing tb <- newTVar False return (tc, ts, tb) @@ -55,7 +55,8 @@ instance Exec BufferedPipeReader where atomically $ writeTChan tc (to, tg, dt) reader p tc - writer :: TChan (Int, Bool, String) -> TMVar String -> TVar Bool -> IO () + writer :: TChan (Int, Bool, String) + -> TVar (Maybe String) -> TVar Bool -> IO () writer tc ts otb = do (to, tg, dt, ntb) <- update cb dt @@ -70,14 +71,14 @@ instance Exec BufferedPipeReader where update :: IO (Int, Bool, String, TVar Bool) update = atomically $ do (to, tg, dt) <- readTChan tc - when (to == 0) $ tryPutTMVar ts dt >> return () + when (to == 0) $ writeTVar ts $ Just dt writeTVar otb False tb <- newTVar True return (to, tg, dt, tb) - reset :: Int -> Bool -> TMVar String -> TVar Bool -> IO () + reset :: Int -> Bool -> TVar (Maybe String) -> TVar Bool -> IO () reset to tg ts tb = do threadDelay ( to * 100 * 1000 ) readTVarIO tb >>= \b -> when b $ do when tg $ putMVar signal Hide - atomically (tryTakeTMVar ts) >>= maybe (return ()) cb + atomically (readTVar ts) >>= maybe (return ()) cb |