From 81289a1382f901b11320130f8a9c07e593a468f3 Mon Sep 17 00:00:00 2001
From: Jochen Keil <jochen.keil@gmail.com>
Date: Tue, 14 Aug 2012 20:34:05 +0200
Subject: 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).
---
 src/Plugins/BufferedPipeReader.hs | 13 +++++++------
 1 file 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
-- 
cgit v1.2.3