haskell - 在 Haskell 中测试异步异常下的正确性

Question

我正在尝试对异步异常下的正确行为进行测试。为了使事情具体化，请考虑以下示例，

casMVar :: Eq a => MVar a -> a -> a -> IO Bool
casMVar m old new = do
  cur <- takeMVar m
  if cur == old
  then putMVar m new >> return True
  else putMVar m old >> return False

其中不变量是 m 不为空。我认为在异步异常下违反了这个不变量，因为这样的异常可能会到达 if 表达式。然而，在我的机器上，它不会通过在 fork 的 casMVar 上抛出异常来暴露，并且延迟会增加，就像这样，

values :: Maybe (List Bool)
values = action <$> killDelays
where
  killDelays = toDelays <$> [-100..100]
  toDelays :: Int -> (Int, Int)
  toDelays dt = if dt < 0 then (-dt, 0) else (0, dt)
  action :: (Int, Int) -> IO (Maybe Bool)
  action (s, t) = do
    m <- newMVar False
    threadId <- forkIO $ threadDelay s >> void (casMVar m False True)
    threadDelay t
    throwTo threadId ThreadKilled
    tryReadMVar m

虽然 values 是 Just False 的列表与 Just True 的列表串联。

有什么方法可以揭露违规行为吗？或者至少增加在某些 机器上违规被曝光的可能性？我特别不是在寻找使此代码正确的方法，问题纯粹是关于测试的。

Answer 1

我不知道在异步异常下测试任意代码的通用方法。对于您给出的特定示例，我将简单地传递一个异常抛出值作为 casMVar 的参数，并检查在 casMVar 评估之后是否是 MVar 非空:

boom = error "Handle me!"

pokemonHandler :: a -> SomeException -> IO a
pokemonHandler a e = return a

spec :: Spec
spec = do
  describe "casMVar" $ do
    it "puts back a value on the MVar under an exception" $ do
      m <- newMVar "foo"
      a <- async $
        casMVar m boom "bar" `catch` pokemonHandler True
      _ <- wait a
      val <- readMVar m
      val `shouldBe` "foo"

完整的代码可以在这里找到https://github.com/capitanbatata/sandbox/tree/master/testing-under-async-exceptions