[Git][ghc/ghc][wip/romes/27514] more fixes
Rodrigo Mesquita pushed to branch wip/romes/27514 at Glasgow Haskell Compiler / GHC Commits: 9280751b by Rodrigo Mesquita at 2026-08-13T16:42:59+01:00 more fixes - - - - - 1 changed file: - compiler/GHC/Driver/Downsweep.hs Changes: ===================================== compiler/GHC/Driver/Downsweep.hs ===================================== @@ -62,7 +62,7 @@ import GHC.Data.OsPath ( OsPath, unsafeEncodeUtf ) import GHC.Data.StringBuffer import GHC.Data.Graph.Directed.Reachability -import GHC.Utils.Exception ( throwIO, SomeAsyncException ) +import GHC.Utils.Exception ( throwIO, SomeAsyncException, AsyncException (..) ) import GHC.Utils.Outputable import GHC.Utils.Panic import GHC.Utils.Misc @@ -1786,7 +1786,12 @@ parDfsBuild base_map roots key expand = ReaderT $ \ds_env -> do worklist <- newTQueueIO coord_tid <- forkIO $ coordinator ds_env exc_var visited_var worklist pending - `MC.catch` \(e::MC.SomeException) -> atomically (modifyTVar' exc_var (<|> Just e)) + `MC.catch` \case + (e::MC.SomeException) + -- exit cleanly when killed + | Just ThreadKilled <- fromException e -> pure () + -- otherwise signal exc_var for the main thread to throw it + | otherwise -> atomically (modifyTVar' exc_var (<|> Just e)) mapM_ (atomically . writeTQueue worklist) roots mb_exc <- atomically $ do readTVar exc_var >>= \case @@ -1794,8 +1799,7 @@ parDfsBuild base_map roots key expand = ReaderT $ \ds_env -> do -- exit if there's an exception return (Just e) Nothing -> do - -- otherwise, exit only when pending and worklist are both empty, - -- *atomically*; else, `retry`. + -- or exit when pending and worklist are both empty atomically; else, `retry`. empty_worklist <- isEmptyTQueue worklist empty_pending <- Set.null <$> readTVar pending unless (empty_worklist && empty_pending) retry @@ -1829,6 +1833,7 @@ parDfsBuild base_map roots key expand = ReaderT $ \ds_env -> do forkIO $ worker ds_env{ds_make_env = make_env} exc_var visvar worklist pendvar k node + `MC.catch` \(e::MC.SomeException) -> atomically (modifyTVar' exc_var (<|> Just e)) return () worker ds_env@DownsweepEnv{..} exc_var visvar worklist pendvar k node = View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9280751b74348fe5b565ea8f4e96e8d0... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9280751b74348fe5b565ea8f4e96e8d0... You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help
participants (1)
-
Rodrigo Mesquita (@alt-romes)