diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,8 @@ +## [1.0.0.2] - 2023-01-25 + +- Bugfix [#20](https://github.com/awkward-squad/ki/pull/20): previously, a child thread could deadlock when attempting + to propagate an exception to its parent + ## [1.0.0.1] - 2022-08-14 - Compat: support GHC 9.4.1 diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,3 +1,11 @@ +| `ki` | `ki-unlifted` | +| --- | --- | +| [![GitHub CI](https://github.com/awkward-squad/ki/workflows/CI/badge.svg)](https://github.com/awkward-squad/ki/actions) | | +| [![Hackage](https://img.shields.io/hackage/v/ki.svg?label=ki&logo=haskell)](https://hackage.haskell.org/package/ki) | [![Hackage](https://img.shields.io/hackage/v/ki-unlifted.svg?label=ki-unlifted&logo=haskell)](https://hackage.haskell.org/package/ki-unlifted) | +| [![Stackage LTS](https://stackage.org/package/ki/badge/lts)](https://www.stackage.org/lts/package/ki) | [![Stackage LTS](https://stackage.org/package/ki-unlifted/badge/lts)](https://www.stackage.org/lts/package/ki-unlifted) | +| [![Stackage Nightly](https://stackage.org/package/ki/badge/nightly)](https://www.stackage.org/nightly/package/ki) | [![Stackage Nightly](https://stackage.org/package/ki-unlifted/badge/nightly)](https://www.stackage.org/nightly/package/ki-unlifted) | +| [![Dependencies](https://img.shields.io/hackage-deps/v/ki)](https://packdeps.haskellers.com/reverse/ki) | [![Dependencies](https://img.shields.io/hackage-deps/v/ki-unlifted)](https://packdeps.haskellers.com/reverse/ki-unlifted) | + # Overview `ki` is a lightweight structured-concurrency library inspired by many other projects and blog posts: @@ -24,13 +32,3 @@ # Documentation [Hackage documentation](https://hackage.haskell.org/package/ki/docs/Ki.html) - -# Badges / meta - -| `ki` | `ki-unlifted` | -| --- | --- | -| [![GitHub CI](https://github.com/awkward-squad/ki/workflows/CI/badge.svg)](https://github.com/awkward-squad/ki/actions) | | -| [![Hackage](https://img.shields.io/hackage/v/ki.svg?label=ki&logo=haskell)](https://hackage.haskell.org/package/ki) | [![Hackage](https://img.shields.io/hackage/v/ki-unlifted.svg?label=ki-unlifted&logo=haskell)](https://hackage.haskell.org/package/ki-unlifted) | -| [![Stackage LTS](https://stackage.org/package/ki/badge/lts)](https://www.stackage.org/lts/package/ki) | [![Stackage LTS](https://stackage.org/package/ki-unlifted/badge/lts)](https://www.stackage.org/lts/package/ki-unlifted) | -| [![Stackage Nightly](https://stackage.org/package/ki/badge/nightly)](https://www.stackage.org/nightly/package/ki) | [![Stackage Nightly](https://stackage.org/package/ki-unlifted/badge/nightly)](https://www.stackage.org/nightly/package/ki-unlifted) | -| [![Dependencies](https://img.shields.io/hackage-deps/v/ki)](https://packdeps.haskellers.com/reverse/ki) | [![Dependencies](https://img.shields.io/hackage-deps/v/ki-unlifted)](https://packdeps.haskellers.com/reverse/ki-unlifted) | diff --git a/ki.cabal b/ki.cabal --- a/ki.cabal +++ b/ki.cabal @@ -11,8 +11,8 @@ name: ki stability: experimental synopsis: A lightweight structured concurrency library --- tested-with: GHC == 9.0.2, GHC == 9.2.4, GHC == 9.4.1 -version: 1.0.0.1 +tested-with: GHC == 9.0.2, GHC == 9.2.5, GHC == 9.4.4 +version: 1.0.0.2 description: A lightweight structured concurrency library. diff --git a/src/Ki/Internal/Scope.hs b/src/Ki/Internal/Scope.hs --- a/src/Ki/Internal/Scope.hs +++ b/src/Ki/Internal/Scope.hs @@ -41,6 +41,7 @@ import Ki.Internal.Counter import Ki.Internal.Prelude import Ki.Internal.Thread +import GHC.Conc.Sync (readTVarIO) -- | A scope. -- @@ -369,22 +370,54 @@ Nothing -> False Just _ -> True --- TODO document this +-- We have a non-`ScopeClosing` exception to propagate to our parent. +-- +-- If our scope has already begun closing (`startingVar` is -1), then either... +-- +-- (A) We already received a `ScopeClosing`, but then ended up trying to propagate an exception anyway, because we +-- threw a synchronous exception (or were hit by a different asynchronous exception) during our teardown procedure. +-- +-- or +-- +-- (B) We will receive a `ScopeClosing` imminently, because our parent has *just* finished setting `startingVar` to +-- -1, and will proceed to throw ScopeClosing to all of its children. +-- +-- If (A), our parent has asynchronous exceptions masked, so we must inform it of our exception via `childExceptionVar` +-- rather than throwTo. If (B), either mechanism would work. And because we don't if we're in case (A) or (B), we just +-- `childExceptionVar`. +-- +-- And if our scope has not already begun closing (`startingVar` is not -1), then we ought to throw our exception to it. +-- But that might fail due to either... +-- +-- (C) Our parent concurrently closing the scope and sending us a `ScopeClosing`; because it has asynchronous +-- exceptions uninterruptibly masked and we only have asynchronous exception *synchronously* masked, its `throwTo` +-- will return `()`, and ours will throw that `ScopeClosing` asynchronous exception. In this case, since we now know +-- our parent is tearing down and has asynchronous exceptions masked, we again inform it via `childExceptionVar`. +-- +-- (D) Some *other* non-`ScopeClosing` asynchronous exception is raised here. This is truly odd: maybe it's a heap +-- overflow exception from the GHC runtime? Maybe some other thread has smuggled our `ThreadId` out and has manually +-- thrown us an exception for some reason? Either way, because we already have an exception that we are trying to +-- propagate, we just scoot these freaky exceptions under the rug. +-- -- Precondition: interruptibly masked propagateException :: Scope -> Int -> SomeException -> UnexceptionalIO () -propagateException Scope {childExceptionVar, parentThreadId} childId exception = - loop +propagateException Scope {childExceptionVar, parentThreadId, startingVar} childId exception = + UnexceptionalIO (readTVarIO startingVar) >>= \case + -1 -> tryPutChildExceptionVar -- (A) / (B) + _ -> loop where loop :: UnexceptionalIO () loop = unexceptionalTry (throwTo parentThreadId ThreadFailed {childId, exception}) >>= \case - Left IsScopeClosingException -> unexceptionalTryPutMVar_ childExceptionVar exception - -- while blocking on notifying the parent of this exception, we got hit by a random async exception from - -- elsewhere. that's weird and unexpected, but we already have an exception to deliver, so it just gets tossed - -- to the void... - Left _ -> loop + Left IsScopeClosingException -> tryPutChildExceptionVar -- (C) + Left _ -> loop -- (D) Right _ -> pure () + tryPutChildExceptionVar :: UnexceptionalIO () + tryPutChildExceptionVar = + UnexceptionalIO (void (tryPutMVar childExceptionVar exception)) + + -- A little promise that this IO action cannot throw an exception. -- -- Yeah it's verbose, and maybe not that necessary, but the code that bothers to use it really does require @@ -410,7 +443,3 @@ catch (coerce @_ @(a -> IO b) onSuccess <$> action) (pure . coerce @_ @(SomeException -> IO b) onFailure) - -unexceptionalTryPutMVar_ :: MVar a -> a -> UnexceptionalIO () -unexceptionalTryPutMVar_ var x = - coerce (void (tryPutMVar var x)) diff --git a/test/Tests.hs b/test/Tests.hs --- a/test/Tests.hs +++ b/test/Tests.hs @@ -1,8 +1,10 @@ module Main (main) where +import Control.Concurrent (newEmptyMVar, putMVar, takeMVar, threadDelay) import Control.Concurrent.STM (atomically) import Control.Exception import Control.Monad +import GHC.IO (unsafeUnmask) import qualified Ki import Test.Tasty import Test.Tasty.HUnit @@ -97,7 +99,15 @@ mask \restore -> do thread :: Ki.Thread (Either A ()) <- Ki.forkTry scope (throwIO A2) restore (atomically (Ki.awaitAll scope)) `catch` \(_ :: SomeException) -> pure () - atomically (Ki.await thread) + atomically (Ki.await thread), + testCase "child propagates exceptions thrown during cleanup" do + (`shouldThrow` A) do + Ki.scoped \scope -> do + ready <- newEmptyMVar + Ki.forkWith_ scope Ki.defaultThreadOptions {Ki.maskingState = MaskedInterruptible} do + putMVar ready () + unsafeUnmask (forever (threadDelay maxBound)) `finally` throwIO A + takeMVar ready ] data A = A