-
Notifications
You must be signed in to change notification settings - Fork 730
Update semaphore-compat to 2.0.0.0 to fix #9993 #11628
New issue
Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.
By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.
Already on GitHub? Sign in to your account
base: master
Are you sure you want to change the base?
Changes from all commits
File filter
Filter by extension
Conversations
Jump to
Diff view
Diff view
There are no files selected for viewing
| Original file line number | Diff line number | Diff line change |
|---|---|---|
|
|
@@ -183,26 +183,34 @@ newSemaphoreJobControl _ n | |
| | n < 1 || n > 1000 = | ||
| error $ "newParallelJobControl: not a sensible number of jobs: " ++ show n | ||
| newSemaphoreJobControl verbosity maxJobLimit = do | ||
| sem <- freshSemaphore "cabal_semaphore" maxJobLimit | ||
| info verbosity $ | ||
| "Created semaphore called " | ||
| ++ getSemaphoreName (semaphoreName sem) | ||
| ++ " with " | ||
| ++ show maxJobLimit | ||
| ++ " slots." | ||
| outqVar <- newTChanIO | ||
| inqVar <- newTChanIO | ||
| countVar <- newTVarIO 0 | ||
| void (forkIO (worker sem inqVar outqVar)) | ||
| return | ||
| JobControl | ||
| { spawnJob = spawn inqVar countVar | ||
| , collectJob = collect outqVar countVar | ||
| , remainingJobs = remaining countVar | ||
| , cancelJobs = cancel inqVar countVar | ||
| , cleanupJobControl = destroySemaphore sem | ||
| , jobControlSemaphore = Just (semaphoreName sem) | ||
| } | ||
| mbServer <- freshSemaphore "cabal_semaphore" maxJobLimit | ||
| case mbServer of | ||
| Left err -> do | ||
| warn verbosity $ | ||
| "Failed to create semaphore: " ++ show err | ||
| ++ "; falling back to normal parallelism control." | ||
|
Collaborator
There was a problem hiding this comment. Choose a reason for hiding this commentThe reason will be displayed to describe this comment to others. Learn more. Can we say |
||
| newParallelJobControl maxJobLimit | ||
| Right server -> do | ||
| let sem = serverSemaphore server | ||
| info verbosity $ | ||
| "Created semaphore called " | ||
| ++ getSemaphoreName (semaphoreName sem) | ||
| ++ " with " | ||
| ++ show maxJobLimit | ||
| ++ " slots." | ||
| outqVar <- newTChanIO | ||
| inqVar <- newTChanIO | ||
| countVar <- newTVarIO 0 | ||
| void (forkIO (worker sem inqVar outqVar)) | ||
| return | ||
| JobControl | ||
| { spawnJob = spawn inqVar countVar | ||
| , collectJob = collect outqVar countVar | ||
| , remainingJobs = remaining countVar | ||
| , cancelJobs = cancel inqVar countVar | ||
| , cleanupJobControl = destroySemaphoreServer server | ||
| , jobControlSemaphore = Just (semaphoreName sem) | ||
| } | ||
| where | ||
| worker :: Semaphore -> TChan (IO a) -> TChan (Either SomeException a) -> IO () | ||
| worker sem inqVar outqVar = | ||
|
|
@@ -291,8 +299,18 @@ newJobControlFromParStrat verbosity mcompiler parStrat numJobsCap = case parStra | |
| UseSem n -> | ||
| case mcompiler of | ||
| Just compiler | ||
| | jsemSupported compiler -> | ||
| | jsemSupported compiler | ||
| , isJsemCompatible compiler -> | ||
| newSemaphoreJobControl verbosity (capJobs n) | ||
| | jsemSupported compiler -> | ||
| do | ||
| warn verbosity $ | ||
| "Semaphore version mismatch (cabal-install uses v" | ||
| ++ show semaphoreVersion | ||
| ++ ", but the selected GHC reports " | ||
| ++ maybe "no version (assumed v1)" (\v -> "v" ++ show v) (jsemVersion compiler) | ||
| ++ "); not using -jsem, GHC will be invoked without semaphore-based parallelism." | ||
| newParallelJobControl (capJobs n) | ||
| | otherwise -> | ||
| do | ||
| warn verbosity "-jsem is not supported by the selected compiler, falling back to normal parallelism control." | ||
|
|
@@ -303,6 +321,17 @@ newJobControlFromParStrat verbosity mcompiler parStrat numJobsCap = case parStra | |
| where | ||
| capJobs n = min (fromMaybe maxBound numJobsCap) n | ||
|
|
||
| -- | Check if the compiler's semaphore version is compatible with ours. | ||
| -- | ||
| -- If the compiler doesn't report a "Semaphore version" field (GHC 9.8–9.14), | ||
| -- we assume v1. On POSIX, v1 and v2 are incompatible (different mechanisms). | ||
| -- On Windows, all versions are compatible (same Win32 API). | ||
|
Comment on lines
+326
to
+328
Collaborator
There was a problem hiding this comment. Choose a reason for hiding this commentThe reason will be displayed to describe this comment to others. Learn more. Better not say this in this comment IMO. The source of truth is |
||
| isJsemCompatible :: Compiler -> Bool | ||
| isJsemCompatible compiler = | ||
| case jsemVersion compiler of | ||
| Just v -> versionsAreCompatible v semaphoreVersion | ||
| Nothing -> versionsAreCompatible 1 semaphoreVersion | ||
|
|
||
| withJobControl :: IO (JobControl IO a) -> (JobControl IO a -> IO b) -> IO b | ||
| withJobControl mkJC = bracket mkJC cleanupJobControl | ||
|
|
||
|
|
||
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,21 @@ | ||
| --- | ||
| synopsis: Detect semaphore version mismatch between cabal-install and GHC | ||
| packages: [Cabal, cabal-install] | ||
| prs: 0000 | ||
| issues: 0000 | ||
|
Collaborator
There was a problem hiding this comment. Choose a reason for hiding this commentThe reason will be displayed to describe this comment to others. Learn more.
|
||
| significance: significant | ||
| --- | ||
|
|
||
| When using `--semaphore`, cabal-install now checks whether the selected GHC's | ||
|
Collaborator
There was a problem hiding this comment. Choose a reason for hiding this commentThe reason will be displayed to describe this comment to others. Learn more. I think this needs to point out that the whole reason for this change is that v2 of semaphore-compat does not suffer from the issue v1 had with ghc and cabal being linked against different C standard libraies. |
||
| semaphore protocol version is compatible before passing `-jsem`. If the GHC | ||
| reports no `Semaphore version` field (GHC 9.8–9.14, which use v1) and | ||
| cabal-install uses v2, a warning is emitted and cabal-install falls back to | ||
| normal parallelism control instead of passing an incompatible semaphore name. | ||
|
|
||
| On Windows, v1 and v2 are always compatible (same Win32 API), so semaphore | ||
| coordination is preserved across all version combinations. | ||
|
|
||
| - `Cabal`: add `jsemVersion :: Compiler -> Maybe Int` to read the | ||
| `Semaphore version` field from `ghc --info`. | ||
| - `cabal-install`: add `isJsemCompatible` check in `newJobControlFromParStrat`; | ||
| emit a warning and fall back to `-jN` when versions are incompatible. | ||
| Original file line number | Diff line number | Diff line change |
|---|---|---|
|
|
@@ -9,4 +9,3 @@ if impl(ghc >= 9) | |
| ghc-options: -Wunused-packages | ||
| package cabal-testsuite | ||
| ghc-options: -Wwarn=unused-packages | ||
|
|
||
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,4 @@ | ||
| source-repository-package | ||
| type: git | ||
| location: https://gitlab.haskell.org/ghc/semaphore-compat.git | ||
| tag: efb04e774623672b28adb7d8038fb1c40cd5d202 |
There was a problem hiding this comment.
Choose a reason for hiding this comment
The reason will be displayed to describe this comment to others. Learn more.
I'd prefer
Just v <- maybeRead verStr, I think it is easier to read than[(v, ""] <- reads verStr, but up to you.