Skip to content
Snippets Groups Projects
Commit ae5ebdd1 authored by Jens Nolte's avatar Jens Nolte
Browse files

Fork when disposing an async


Co-authored-by: default avatarJan Beinke <git@janbeinke.com>
parent f01d1fd9
No related branches found
No related tags found
No related merge requests found
Pipeline #2537 passed
...@@ -16,7 +16,7 @@ module Quasar.Async.Unmanaged ( ...@@ -16,7 +16,7 @@ module Quasar.Async.Unmanaged (
) where ) where
import Control.Concurrent (ThreadId, forkIOWithUnmask, throwTo) import Control.Concurrent (ThreadId, forkIO, forkIOWithUnmask, throwTo)
import Control.Concurrent.STM import Control.Concurrent.STM
import Control.Monad.Catch import Control.Monad.Catch
import Quasar.Awaitable import Quasar.Awaitable
...@@ -43,16 +43,18 @@ instance IsDisposable (Task r) where ...@@ -43,16 +43,18 @@ instance IsDisposable (Task r) where
TaskStateInitializing -> unreachableCodePathM TaskStateInitializing -> unreachableCodePathM
TaskStateRunning threadId -> do TaskStateRunning threadId -> do
writeTVar stateVar TaskStateThrowing writeTVar stateVar TaskStateThrowing
pure do -- Fork to prevent synchronous exceptions when disposing this thread, and to prevent blocking when disposing
-- a thread that is running in uninterruptible masked state.
pure $ void $ forkIO do
throwTo threadId $ CancelAsync key throwTo threadId $ CancelAsync key
atomically $ writeTVar stateVar TaskStateCompleted atomically $ writeTVar stateVar TaskStateCompleted
TaskStateThrowing -> pure $ pure () TaskStateThrowing -> pure $ pure @IO ()
TaskStateCompleted -> pure $ pure () TaskStateCompleted -> pure $ pure @IO ()
-- Wait for task completion or failure. Tasks must not ignore `CancelTask` or this will hang. -- Wait for task completion or failure. Tasks must not ignore `CancelTask` or this will hang.
pure $ DisposeResultAwait $ isDisposed self pure $ DisposeResultAwait $ isDisposed self
isDisposed (Task _ _ _ resultAwaitable) = (() <$ resultAwaitable) `catchAll` \_ -> pure () isDisposed (Task _ _ _ resultAwaitable) = awaitSuccessOrFailure resultAwaitable
registerFinalizer (Task _ _ finalizers _) = defaultRegisterFinalizer finalizers registerFinalizer (Task _ _ finalizers _) = defaultRegisterFinalizer finalizers
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment