readMVar 不会在 putMVar 上唤醒

Question

在另一个线程调用putMVar 之后，我的代码似乎挂在readMVar 上。我不希望会发生这种情况，但这就是我所观察到的。我的主线程创建了两个新线程，每个线程都可以访问共享的MVar m。

线程 1：

do
  putStrLn "tick"
  x <- readMVar m
  putStrLn "tock"

线程 2：

do
  putMVar m 0
  putStrLn "put m0"
  void $ tryTakeMVar m
  putStrLn "take m"
  putMVar m 1
  putStrLn "put m1"

主要：

do
  m <- newEmptyMVar
  <start thread 1>
  <start thread 2>

在以下场景中，我的程序挂起：

两个线程可以访问一个共享的 MVar m，它最初是空的。 readMVar m 上的线程 1 块。同时，线程 2 调用putMVar m ...。此时，线程 1 可以 继续，但我们假设它没有。线程 2 然后调用tryTakeMVar m，这可能会清空一个完整的MVar。然后线程 2 再次调用putMVar m ...。此场景对应于以下输出：

tick
put m0
take m
put m1
<hang>

这里发生了什么？我希望打印“tock”，因为线程 2 填充了 MVar，但我的程序只是挂起。

Answer 1

我在尝试调试空间泄漏时将我的 MVar 实现从 base 切换到 strict-concurrency。但正如问题所示，我的代码使用tryReadMVar，由于某种原因strict-concurrency 没有提供。因此，不久前，我自己实现了tryReadMVar：

tryReadMVar :: (NFData a) => MVar a -> IO (Maybe a)
tryReadMVar m = do
  mm <- tryTakeMVar m
  case mm of
    Nothing -> return ()
    Just a -> putMVar m a
  return mm

没有真正考虑影响。从那以后我就完全忘记了这样做。正如 Daniel 指出的那样，旧版本的 base 曾经做类似的事情，但新版本有一个原子的 tryReadMVar 实现。因此，即使我使用的是新版本的 GHC，由于使用了strict-concurrency，问题又再次出现。

同时，死锁发生在以下情况（丹尼尔描述）：

• 线程 1 打印“滴答”
• 线程 2 使用 putMVar 放置 mvar
• 线程 2 打印“put m0”
• 线程 1 在 tryReadMVar 中使用 tryTakeMVar 获取 mvar
• 线程 2 使用 tryTakeMVar 获取 mvar
• thread2 打印“take m”
• thread2 使用 putMVar 放置 mvar
• thread2 打印“put m1”
• 线程 1 在尝试在 tryReadMVar 内尝试 putMVar 时发生死锁

事实证明，拥有一个原子tryReadMVar 很有用！