diff --git a/Cabal/src/Distribution/Simple/Compiler.hs b/Cabal/src/Distribution/Simple/Compiler.hs index 38478a71b4c..805de301644 100644 --- a/Cabal/src/Distribution/Simple/Compiler.hs +++ b/Cabal/src/Distribution/Simple/Compiler.hs @@ -86,6 +86,7 @@ module Distribution.Simple.Compiler , libraryDynDirSupported , libraryVisibilitySupported , jsemSupported + , jsemVersion , reexportedAsSupported -- * Support for profiling detail levels @@ -480,6 +481,17 @@ jsemSupported comp = case compilerFlavor comp of where v = compilerVersion comp +-- | What semaphore protocol version does this compiler use? +-- +-- Returns @Nothing@ for compilers that don't report a "Semaphore version" +-- field in @ghc --info@ (i.e. GHC 9.8–9.14, which use v1). +jsemVersion :: Compiler -> Maybe Int +jsemVersion comp = case compilerFlavor comp of + GHC -> case Map.lookup "Semaphore version" (compilerProperties comp) of + Just verStr | [(v, "")] <- reads verStr -> Just v + _ -> Nothing + _ -> Nothing + -- | Does the compiler support the -reexported-modules "A as B" syntax reexportedAsSupported :: Compiler -> Bool reexportedAsSupported comp = case compilerFlavor comp of diff --git a/cabal-install/cabal-install.cabal b/cabal-install/cabal-install.cabal index 933e361be30..33d512538de 100644 --- a/cabal-install/cabal-install.cabal +++ b/cabal-install/cabal-install.cabal @@ -270,7 +270,7 @@ library , regex-base >= 0.94.0.0 && <0.95 , regex-posix >= 0.96.0.0 && <0.97 , safe-exceptions >= 0.1.7.0 && < 0.2 - , semaphore-compat >= 1.0.0 && < 1.1 + , semaphore-compat >= 2.0.0 && < 2.1 if flag(native-dns) if os(windows) diff --git a/cabal-install/src/Distribution/Client/JobControl.hs b/cabal-install/src/Distribution/Client/JobControl.hs index 280916fdf6c..9df6bd96841 100644 --- a/cabal-install/src/Distribution/Client/JobControl.hs +++ b/cabal-install/src/Distribution/Client/JobControl.hs @@ -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." + 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). +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 diff --git a/cabal.project b/cabal.project index a2075cfdc29..de451969cc0 100644 --- a/cabal.project +++ b/cabal.project @@ -2,6 +2,7 @@ import: project-cabal/ghc-options.config import: project-cabal/ghc-latest.config import: project-cabal/pkgs.config import: project-cabal/constraints.config +import: project-cabal/source-deps.config tests: True diff --git a/cabal.validate-libonly.project b/cabal.validate-libonly.project index 7c5bd38ab6b..c750b8c31e7 100644 --- a/cabal.validate-libonly.project +++ b/cabal.validate-libonly.project @@ -3,6 +3,7 @@ import: project-cabal/pkgs/cabal.config import: project-cabal/pkgs/tests.config import: project-cabal/pkgs/integration-tests.config import: project-cabal/constraints.config +import: project-cabal/source-deps.config tests: True write-ghc-environment-files: never diff --git a/cabal.validate.project b/cabal.validate.project index bf2552af2d0..6081f292725 100644 --- a/cabal.validate.project +++ b/cabal.validate.project @@ -2,6 +2,7 @@ import: project-cabal/ghc-options.config import: project-cabal/ghc-latest.config import: project-cabal/pkgs.config import: project-cabal/constraints.config +import: project-cabal/source-deps.config tests: True write-ghc-environment-files: never diff --git a/changelog.d/semaphore-version-compat.md b/changelog.d/semaphore-version-compat.md new file mode 100644 index 00000000000..fcd2a1a1d97 --- /dev/null +++ b/changelog.d/semaphore-version-compat.md @@ -0,0 +1,21 @@ +--- +synopsis: Detect semaphore version mismatch between cabal-install and GHC +packages: [Cabal, cabal-install] +prs: 0000 +issues: 0000 +significance: significant +--- + +When using `--semaphore`, cabal-install now checks whether the selected GHC's +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. diff --git a/project-cabal/ghc-options.config b/project-cabal/ghc-options.config index 4be19aa246d..99794c17465 100644 --- a/project-cabal/ghc-options.config +++ b/project-cabal/ghc-options.config @@ -9,4 +9,3 @@ if impl(ghc >= 9) ghc-options: -Wunused-packages package cabal-testsuite ghc-options: -Wwarn=unused-packages - diff --git a/project-cabal/source-deps.config b/project-cabal/source-deps.config new file mode 100644 index 00000000000..0c7b5969362 --- /dev/null +++ b/project-cabal/source-deps.config @@ -0,0 +1,4 @@ +source-repository-package + type: git + location: https://gitlab.haskell.org/ghc/semaphore-compat.git + tag: efb04e774623672b28adb7d8038fb1c40cd5d202