Zubin pushed to branch wip/semaphore-v2 at Glasgow Haskell Compiler / GHC

Commits:

16 changed files:

Changes:

  • changelog.d/jobserver-leak-fix
    1 
    +section: compiler
    2 
    +issues: #27253
    3 
    +mrs: !15729
    4 
    +synopsis:
    5 
    +  Fix a token leak in the ``-jsem`` jobserver shutdown path
    6 
    +description:
    7 
    +  A build interrupted by Ctrl-C while a ``-jsem`` token transfer was in
    8 
    +  flight could leak that token.

  • changelog.d/semaphore-v2
    1 
    +section: compiler
    2 
    +issues: #25087
    3 
    +mrs: !15729
    4 
    +synopsis:
    5 
    +  Update to semaphore-compat 2.0.0 (``-jsem`` protocol v2)
    6 
    +description:
    7 
    +  On Linux and other POSIX platforms, GHC's ``-jsem`` jobserver client
    8 
    +  now speaks v2 of the semaphore-compat protocol, which uses Unix
    9 
    +  domain sockets in place of POSIX named semaphores. This avoids the
    10 
    +  libc-ABI issues that affected the old implementation. Windows is
    11 
    +  unaffected and continues to use the v1 protocol (Win32 named
    12 
    +  semaphores); its reported protocol version remains v1.
    13 
    +
    14 
    +  When GHC receives a ``-jsem`` name whose protocol version it does not
    15 
    +  support, it now emits a ``-Wsemaphore-version-mismatch`` warning and
    16 
    +  falls back to ``-j1`` rather than crashing. ``ghc --info`` exposes the
    17 
    +  supported version in a new ``"Semaphore version"`` entry so
    18 
    +  cabal-install can detect a mismatch before invoking GHC.
    19 
    +
    20 
    +  Users on a ``cabal-install`` that predates the v2 update will continue
    21 
    +  to build successfully, but on Linux/POSIX will lose the cross-process
    22 
    +  ``-jsem`` coordination and fall back to ``-j1`` per GHC invocation.
    23 
    +  To recover full parallelism, upgrade to a ``cabal-install`` that
    24 
    +  supports protocol v2.
    25 
    +
    26 
    +  See also:
    27 
    +
    28 
    +  - the `GHC proposal amendment <https://github.com/ghc-proposals/ghc-proposals/pull/673>`_
    29 
    +  - the `cabal-install patch <https://github.com/haskell/cabal/pull/11628>`_
    30 
    +  - the `semaphore-compat library MR <https://gitlab.haskell.org/ghc/semaphore-compat/-/merge_requests/8>`_

  • compiler/GHC/Driver/Errors/Ppr.hs
    ... ... @@ -24,6 +24,8 @@ import GHC.Types.Hint
    24 24 
     import GHC.Types.SrcLoc
    25 25 
     import Data.Version
    26 26
    27 
    +import System.Semaphore
    28 
    +  ( SemaphoreError(..), getSemaphoreProtocolVersion )
    27 29 
     import Language.Haskell.Syntax.Decls (RuleDecl(..))
    28 30 
     import GHC.Tc.Errors.Types (TcRnMessage)
    29 31 
     import GHC.HsToCore.Errors.Types (DsMessage)
    ... ... @@ -90,6 +92,20 @@ instance Diagnostic GhcMessage where
    90 92 
     instance HasDefaultDiagnosticOpts DriverMessageOpts where
    91 93 
       defaultOpts = DriverMessageOpts (defaultDiagnosticOpts @PsMessage) (defaultDiagnosticOpts @IfaceMessage)
    92 94
    95 
    +pprSemaphoreError :: SemaphoreError -> SDoc
    96 
    +pprSemaphoreError = \case
    97 
    +  SemaphoreAlreadyExists nm ->
    98 
    +    text "a semaphore named" <+> quotes (text nm) <+> text "already exists"
    99 
    +  SemaphoreDoesNotExist nm ->
    100 
    +    text "no semaphore named" <+> quotes (text nm)
    101 
    +  SemaphoreIncompatibleVersion got want ->
    102 
    +    text "protocol version mismatch (got v"
    103 
    +    <> int (getSemaphoreProtocolVersion got)
    104 
    +    <> text ", supported v"
    105 
    +    <> int (getSemaphoreProtocolVersion want) <> text ")"
    106 
    +  SemaphoreOtherError ioe ->
    107 
    +    text (show ioe)
    108 
    +
    93 109 
     instance Diagnostic DriverMessage where
    94 110 
       type DiagnosticOpts DriverMessage = DriverMessageOpts
    95 111 
       diagnosticMessage opts = \case
    ... ... @@ -282,6 +298,10 @@ instance Diagnostic DriverMessage where
    282 298 
           -> mkSimpleDecorated $
    283 299 
             vcat [ text "The following modules are missing a linkable which is needed for creating a library:"
    284 300 
                  , nest 2 $ hcat (map ppr mods) ]
    301 
    +    DriverSemaphoreOpenFailure _ err
    302 
    +      -> mkSimpleDecorated $
    303 
    +        text "Failed to open -jsem semaphore:" <+> pprSemaphoreError err <>
    304 
    +        text "; ignoring -jsem and compiling sequentially."
    285 305
    286 306 
       diagnosticReason = \case
    287 307 
         DriverUnknownMessage m
    ... ... @@ -355,6 +375,8 @@ instance Diagnostic DriverMessage where
    355 375 
           -> WarningWithoutFlag
    356 376 
         DriverMissingLinkableForModule {}
    357 377 
           -> ErrorWithoutFlag
    378 
    +    DriverSemaphoreOpenFailure {}
    379 
    +      -> WarningWithFlag Opt_WarnSemaphoreOpenFailure
    358 380
    359 381 
       diagnosticHints = \case
    360 382 
         DriverUnknownMessage m
    ... ... @@ -430,5 +452,19 @@ instance Diagnostic DriverMessage where
    430 452 
           -> noHints
    431 453 
         DriverMissingLinkableForModule {}
    432 454 
           -> noHints
    455 
    +    DriverSemaphoreOpenFailure buildingCabal (SemaphoreIncompatibleVersion received supported)
    456 
    +      | received < supported
    457 
    +      -> let required = getSemaphoreProtocolVersion supported
    458 
    +             target = case buildingCabal of
    459 
    +               YesBuildingCabalPackage -> UpgradeCabalInstall
    460 
    +               NoBuildingCabalPackage  -> UpgradeJobserver
    461 
    +         in [SuggestUpgradeForSemaphoreVersionMismatch target required]
    462 
    +      | received > supported
    463 
    +      -> [SuggestUpgradeForSemaphoreVersionMismatch
    464 
    +            UpgradeGHC (getSemaphoreProtocolVersion received)]
    465 
    +      | otherwise
    466 
    +      -> noHints
    467 
    +    DriverSemaphoreOpenFailure {}
    468 
    +      -> noHints
    433 469
    434 470 
       diagnosticCode = constructorCode @GHC

  • compiler/GHC/Driver/Errors/Types.hs
    ... ... @@ -37,6 +37,7 @@ import qualified GHC.LanguageExtensions as LangExt
    37 37
    38 38 
     import GHC.Generics ( Generic )
    39 39
    40 
    +import System.Semaphore ( SemaphoreError )
    40 41 
     import GHC.Tc.Errors.Types
    41 42 
     import GHC.Iface.Errors.Types
    42 43
    ... ... @@ -419,6 +420,17 @@ data DriverMessage where
    419 420
    420 421 
       DriverMissingLinkableForModule :: ![Module] -> DriverMessage
    421 422
    423 
    +  {-| DriverSemaphoreOpenFailure is a warning that occurs when GHC fails to
    424 
    +      open the semaphore specified by @-jsem@, e.g. the socket does not
    425 
    +      exist, the protocol version is incompatible, or a system error
    426 
    +      occurred.  GHC ignores @-jsem@ and compiles sequentially.
    427 
    +
    428 
    +      The 'BuildingCabalPackage' flag controls whether the diagnostic
    429 
    +      hint suggests upgrading @cabal-install@ (it only does so when GHC
    430 
    +      is invoked by Cabal).
    431 
    +  -}
    432 
    +  DriverSemaphoreOpenFailure :: !BuildingCabalPackage -> !SemaphoreError -> DriverMessage
    433 
    +
    422 434 
     deriving instance Generic DriverMessage
    423 435
    424 436 
     data DriverMessageOpts =

  • compiler/GHC/Driver/Flags.hs
    ... ... @@ -1115,6 +1115,7 @@ data WarningFlag =
    1115 1115 
        | Opt_WarnUnusableUnpackPragmas                   -- ^ @since 9.14
    1116 1116 
        | Opt_WarnPatternNamespaceSpecifier               -- ^ @since 9.14
    1117 1117 
        | Opt_WarnUnrecognisedModifiers                   -- ^ @since 10.0
    1118 
    +   | Opt_WarnSemaphoreOpenFailure                   -- Since 10.0.1
    1118 1119 
        deriving (Eq, Ord, Show, Enum, Bounded)
    1119 1120
    1120 1121 
     -- | Return the names of a WarningFlag
    ... ... @@ -1237,6 +1238,7 @@ warnFlagNames wflag = case wflag of
    1237 1238 
       Opt_WarnUnusableUnpackPragmas                   -> "unusable-unpack-pragmas" :| []
    1238 1239 
       Opt_WarnPatternNamespaceSpecifier               -> "pattern-namespace-specifier" :| []
    1239 1240 
       Opt_WarnUnrecognisedModifiers                   -> "unrecognised-modifiers" :| []
    1241 
    +  Opt_WarnSemaphoreOpenFailure                   -> "semaphore-open-failure" :| []
    1240 1242
    1241 1243 
     -- -----------------------------------------------------------------------------
    1242 1244 
     -- Standard sets of warning options
    ... ... @@ -1383,7 +1385,8 @@ standardWarnings -- see Note [Documenting warning flags]
    1383 1385 
             Opt_WarnDeprecatedPragmas,
    1384 1386 
             Opt_WarnRuleLhsEqualities,
    1385 1387 
             Opt_WarnUnusableUnpackPragmas,
    1386 
    -        Opt_WarnUnrecognisedModifiers
    1388 
    +        Opt_WarnUnrecognisedModifiers,
    1389 
    +        Opt_WarnSemaphoreOpenFailure
    1387 1390 
           ]
    1388 1391
    1389 1392 
     -- | Things you get with @-W@.

  • compiler/GHC/Driver/MakeAction.hs
    ... ... @@ -28,6 +28,21 @@ import GHC.Driver.Errors.Types
    28 28 
     import GHC.Driver.Messager
    29 29 
     import GHC.Driver.MakeSem
    30 30
    31 
    +#if defined(wasm32_HOST_ARCH) || defined(javascript_HOST_ARCH)
    32 
    +import System.Semaphore
    33 
    +  ( SemaphoreIdentifier )
    34 
    +#else
    35 
    +import System.Semaphore
    36 
    +  ( SemaphoreError, SemaphoreIdentifier )
    37 
    +#endif
    38 
    +
    39 
    +#if !(defined(wasm32_HOST_ARCH) || defined(javascript_HOST_ARCH))
    40 
    +import GHC.Driver.Config.Diagnostic ( initDiagOpts, initPrintConfig )
    41 
    +import GHC.Driver.Errors ( printOrThrowDiagnostics )
    42 
    +import GHC.Types.Error ( singleMessage )
    43 
    +import GHC.Types.SrcLoc ( noSrcSpan )
    44 
    +import GHC.Utils.Error ( mkPlainMsgEnvelope )
    45 
    +#endif
    31 46 
     import GHC.Utils.Logger
    32 47 
     import GHC.Utils.TmpFs
    33 48
    ... ... @@ -49,7 +64,7 @@ mkWorkerLimit :: DynFlags -> IO WorkerLimit
    49 64 
     mkWorkerLimit dflags =
    50 65 
       case parMakeCount dflags of
    51 66 
         Nothing -> pure $ num_procs 1
    52 
    -    Just (ParMakeSemaphore h) -> pure (JSemLimit (SemaphoreName h))
    67 
    +    Just (ParMakeSemaphore h) -> pure (JSemLimit h)
    53 68 
         Just ParMakeNumProcessors -> num_procs <$> getNumProcessors
    54 69 
         Just (ParMakeThisMany n) -> pure $ num_procs n
    55 70 
       where
    ... ... @@ -65,8 +80,8 @@ isWorkerLimitSequential (JSemLimit {}) = False
    65 80 
     data WorkerLimit
    66 81 
       = NumProcessorsLimit Int
    67 82 
       | JSemLimit
    68 
    -    SemaphoreName
    69 
    -      -- ^ Semaphore name to use
    83 
    +    SemaphoreIdentifier
    84 
    +      -- ^ Semaphore identifier from @-jsem@
    70 85 
       deriving Eq
    71 86
    72 87 
     -- | Environment used when compiling a module
    ... ... @@ -122,17 +137,24 @@ runNjobsAbstractSem n_jobs action = do
    122 137 
         resetNumCapabilities = set_num_caps n_capabilities
    123 138 
       MC.bracket_ updNumCapabilities resetNumCapabilities $ action asem
    124 139
    125 
    -runWorkerLimit :: WorkerLimit -> (AbstractSem -> IO a) -> IO a
    126 
    -#if defined(wasm32_HOST_ARCH)
    127 
    -runWorkerLimit _ action = do
    140 
    +runWorkerLimit :: Logger -> DynFlags -> WorkerLimit -> (AbstractSem -> IO a) -> IO a
    141 
    +#if defined(wasm32_HOST_ARCH) || defined(javascript_HOST_ARCH)
    142 
    +runWorkerLimit _logger _dflags _ action = do
    128 143 
       lock <- newMVar ()
    129 144 
       action $ AbstractSem (takeMVar lock) (putMVar lock ())
    130 145 
     #else
    131 
    -runWorkerLimit worker_limit action = case worker_limit of
    146 
    +runWorkerLimit logger dflags worker_limit action = case worker_limit of
    132 147 
         NumProcessorsLimit n_jobs ->
    133 148 
           runNjobsAbstractSem n_jobs action
    134 
    -    JSemLimit sem ->
    135 
    -      runJSemAbstractSem sem action
    149 
    +    JSemLimit sem_ident -> do
    150 
    +      result <- MC.try @_ @SemaphoreError $ runJSemAbstractSem sem_ident action
    151 
    +      case result of
    152 
    +        Right a -> return a
    153 
    +        Left err -> do
    154 
    +          let diag = DriverSemaphoreOpenFailure (checkBuildingCabalPackage dflags) err
    155 
    +              msg  = singleMessage $ mkPlainMsgEnvelope (initDiagOpts dflags) noSrcSpan diag
    156 
    +          printOrThrowDiagnostics logger (initPrintConfig dflags) (initDiagOpts dflags) (GhcDriverMessage <$> msg)
    157 
    +          runNjobsAbstractSem 1 action
    136 158 
     #endif
    137 159
    138 160 
     -- | Build and run a pipeline
    ... ... @@ -159,7 +181,7 @@ runParPipelines worker_limit plugin_hsc_env diag_wrapper mHscMessager all_pipeli
    159 181 
       thread_safe_logger <- liftIO $ makeThreadSafe (hsc_logger plugin_hsc_env)
    160 182 
       let thread_safe_hsc_env = plugin_hsc_env { hsc_logger = thread_safe_logger }
    161 183
    162 
    -  runWorkerLimit worker_limit $ \abstract_sem -> do
    184 
    +  runWorkerLimit (hsc_logger plugin_hsc_env) (hsc_dflags plugin_hsc_env) worker_limit $ \abstract_sem -> do
    163 185 
         let env = MakeEnv { hsc_env = thread_safe_hsc_env
    164 186 
                           , withLogger = withParLog log_queue_queue_var
    165 187 
                           , compile_sem = abstract_sem
    ... ... @@ -245,4 +267,4 @@ type RunMakeM a = ReaderT MakeEnv (MaybeT IO) a
    245 267 
     data MakeAction = forall a . MakeAction !(RunMakeM a) !(MVar (Maybe a))
    246 268
    247 269 
     waitMakeAction :: MakeAction -> IO ()
    248 
    -waitMakeAction (MakeAction _ mvar) = () <$ readMVar mvar
    \ No newline at end of file
    270 
    +waitMakeAction (MakeAction _ mvar) = () <$ readMVar mvar

  • compiler/GHC/Driver/MakeSem.hs
    1 1 
     {-# LANGUAGE BlockArguments #-}
    2 
    +{-# LANGUAGE CPP #-}
    2 3 
     {-# LANGUAGE RecordWildCards #-}
    3 4
    4 5 
     -- | Implementation of a jobserver using system semaphores.
    5 6 
     --
    6 7 
     --
    7 8 
     module GHC.Driver.MakeSem
    8 
    -  ( -- * JSem: parallelism semaphore backed
    9 
    +  (
    10 
    +#if !(defined(wasm32_HOST_ARCH) || defined(javascript_HOST_ARCH))
    11 
    +    -- * JSem: parallelism semaphore backed
    9 12 
         -- by a system semaphore (Posix/Windows)
    10 
    -    runJSemAbstractSem
    11 
    -
    12 
    -  -- * System semaphores
    13 
    -  , Semaphore, SemaphoreName(..)
    13 
    +    runJSemAbstractSem,
    14 
    +#endif
    14 15
    15 16 
       -- * Abstract semaphores
    16 
    -  , AbstractSem(..)
    17 
    +    AbstractSem(..)
    17 18 
       , withAbstractSem
    18 19 
       )
    19 20 
       where
    20 21
    21 22 
     import GHC.Prelude
    23 
    +
    24 
    +#if defined(wasm32_HOST_ARCH) || defined(javascript_HOST_ARCH)
    25 
    +
    26 
    +import System.Semaphore
    27 
    +  ( AbstractSem(..)
    28 
    +  , withAbstractSem
    29 
    +  )
    30 
    +
    31 
    +#else
    32 
    +
    22 33 
     import GHC.Conc
    23 34 
     import GHC.Data.OrdList
    24 35 
     import GHC.IO.Exception
    ... ... @@ -27,6 +38,15 @@ import GHC.Utils.Panic
    27 38 
     import GHC.Utils.Json
    28 39
    29 40 
     import System.Semaphore
    41 
    +  ( AbstractSem(..)
    42 
    +  , ClientSemaphore
    43 
    +  , SemaphoreIdentifier
    44 
    +  , SemaphoreToken
    45 
    +  , openSemaphore
    46 
    +  , releaseSemaphoreToken
    47 
    +  , waitOnSemaphore
    48 
    +  , withAbstractSem
    49 
    +  )
    30 50
    31 51 
     import Control.Monad
    32 52 
     import qualified Control.Monad.Catch as MC
    ... ... @@ -46,11 +66,14 @@ import Debug.Trace
    46 66 
     -- available from the semaphore.
    47 67 
     data Jobserver
    48 68 
       = Jobserver
    49 
    -  { jSemaphore :: !Semaphore
    69 
    +  { jSemaphore :: !ClientSemaphore
    50 70 
         -- ^ The semaphore which controls available resources
    51 71 
       , jobs :: !(TVar JobResources)
    52 72 
         -- ^ The currently pending jobs, and the resources
    53 73 
         -- obtained from the semaphore
    74 
    +  , activeChild :: !(TVar (Maybe (ThreadId, TMVar (Maybe MC.SomeException))))
    75 
    +    -- ^ Handle on the current acquire thread (if any). The loop's exit
    76 
    +    -- handler reads this to drain a still-running child on shutdown.
    54 77 
       }
    55 78
    56 79 
     data JobserverOptions
    ... ... @@ -81,6 +104,9 @@ data JobResources
    81 104 
       , jobsWaiting :: !(OrdList (TMVar ()))
    82 105 
         -- ^ Pending jobs waiting on a token, the job will be blocked on the TMVar so putting into
    83 106 
         -- the TMVar will allow the job to continue.
    107 
    +  , heldTokens  :: [SemaphoreToken]
    108 
    +    -- ^ Actual semaphore tokens (for release/cleanup).
    109 
    +    -- Length should equal tokensOwned - 1 (the implicit token has no SemaphoreToken).
    84 110 
       }
    85 111
    86 112 
     instance Outputable JobResources where
    ... ... @@ -93,9 +119,9 @@ instance Outputable JobResources where
    93 119 
               ] )
    94 120
    95 121 
     -- | Add one new token.
    96 
    -addToken :: JobResources -> JobResources
    97 
    -addToken jobs@( Jobs { tokensOwned = owned, tokensFree = free })
    98 
    -  = jobs { tokensOwned = owned + 1, tokensFree = free + 1 }
    122 
    +addToken :: SemaphoreToken -> JobResources -> JobResources
    123 
    +addToken tok jobs@( Jobs { tokensOwned = owned, tokensFree = free, heldTokens = toks })
    124 
    +  = jobs { tokensOwned = owned + 1, tokensFree = free + 1, heldTokens = tok : toks }
    99 125
    100 126 
     -- | Free one token.
    101 127 
     addFreeToken :: JobResources -> JobResources
    ... ... @@ -111,12 +137,14 @@ removeFreeToken jobs@( Jobs { tokensFree = free })
    111 137 
           (text "removeFreeToken:" <+> ppr free)
    112 138 
       $ jobs { tokensFree = free - 1 }
    113 139
    114 
    --- | Return one owned token.
    115 
    -removeOwnedToken :: JobResources -> JobResources
    116 
    -removeOwnedToken jobs@( Jobs { tokensOwned = owned })
    140 
    +-- | Return one owned token, extracting the 'SemaphoreToken' for release.
    141 
    +removeOwnedToken :: JobResources -> (SemaphoreToken, JobResources)
    142 
    +removeOwnedToken jobs@( Jobs { tokensOwned = owned, heldTokens = toks })
    117 143 
       = assertPpr (owned > 1)
    118 144 
           (text "removeOwnedToken:" <+> ppr owned)
    119 
    -  $ jobs { tokensOwned = owned - 1 }
    145 
    +  $ case toks of
    146 
    +      (t:rest) -> (t, jobs { tokensOwned = owned - 1, heldTokens = rest })
    147 
    +      []       -> panic "removeOwnedToken: no held tokens"
    120 148
    121 149 
     -- | Add one new job to the end of the list of pending jobs.
    122 150 
     addJob :: TMVar () -> JobResources -> JobResources
    ... ... @@ -143,7 +171,7 @@ data JobserverAction
    143 171 
       = Idle
    144 172 
       -- | A thread is waiting for a token on the semaphore.
    145 173 
       | Acquiring
    146 
    -    { activeWaitId   :: WaitId
    174 
    +    { activeThreadId :: ThreadId
    147 175 
         , threadFinished :: TMVar (Maybe MC.SomeException) }
    148 176
    149 177 
     -- | Retrieve the 'TMVar' that signals if the current thread has finished,
    ... ... @@ -189,17 +217,30 @@ releaseJob jobs_tvar = do
    189 217 
           return ((), addFreeToken jobs)
    190 218
    191 219
    192 
    --- | Release all tokens owned from the semaphore (to clean up
    193 
    --- the jobserver at the end).
    194 
    -cleanupJobserver :: Jobserver -> IO ()
    195 
    -cleanupJobserver (Jobserver { jSemaphore = sem
    196 
    -                            , jobs       = jobs_tvar })
    197 
    -  = do
    198 
    -    Jobs { tokensOwned = owned } <- readTVarIO jobs_tvar
    199 
    -    let toks_to_release = owned - 1
    200 
    -      -- Subtract off the implicit token: whoever spawned the ghc process
    201 
    -      -- in the first place is responsible for that token.
    202 
    -    releaseSemaphore sem toks_to_release
    220 
    +-- | Kill the current acquire thread, if any, and wait for it to exit.
    221 
    +--
    222 
    +-- Called from the jobserver loop's exit handler, which runs masked.
    223 
    +-- Relies on the invariant from 'acquireThread' that a forked child
    224 
    +-- always fills its 'threadFinished' TMVar before it dies; this is what
    225 
    +-- lets the 'takeTMVar' below terminate after the 'killThread'.
    226 
    +drainActiveChild :: Jobserver -> IO ()
    227 
    +drainActiveChild (Jobserver { activeChild = active_tvar }) = do
    228 
    +  mb <- readTVarIO active_tvar
    229 
    +  for_ mb $ \(tid, tmv) -> do
    230 
    +    killThread tid
    231 
    +    void $ atomically (takeTMVar tmv)
    232 
    +    atomically $ writeTVar active_tvar Nothing
    233 
    +
    234 
    +-- | Release every token currently in 'heldTokens'.
    235 
    +--
    236 
    +-- Called from the jobserver loop's exit handler, which runs masked,
    237 
    +-- after 'drainActiveChild': no other thread is mutating 'JobResources'
    238 
    +-- at this point.
    239 
    +releaseAllHeld :: Jobserver -> IO ()
    240 
    +releaseAllHeld (Jobserver { jobs = jobs_tvar }) = do
    241 
    +  Jobs { heldTokens = toks } <- readTVarIO jobs_tvar
    242 
    +  forM_ toks $ \t ->
    243 
    +    void $ MC.try @_ @MC.SomeException (releaseSemaphoreToken t)
    203 244
    204 245 
     -- | Dispatch the available tokens acquired from the semaphore
    205 246 
     -- to the pending jobs in the job server.
    ... ... @@ -252,7 +293,7 @@ tracedAtomically origin act = do
    252 293 
       return a
    253 294
    254 295 
     renderJobResources :: String -> JobResources -> String
    255 
    -renderJobResources origin (Jobs own free pending) = showSDocUnsafe $ renderJSON $
    296 
    +renderJobResources origin (Jobs own free pending _heldToks) = showSDocUnsafe $ renderJSON $
    256 297 
       JSObject [ ("name", JSString origin)
    257 298 
                , ("owned", JSInt own)
    258 299 
                , ("free", JSInt free)
    ... ... @@ -262,61 +303,68 @@ renderJobResources origin (Jobs own free pending) = showSDocUnsafe $ renderJSON
    262 303
    263 304 
     -- | Spawn a new thread that waits on the semaphore in order to acquire
    264 305 
     -- an additional token.
    306 
    +--
    307 
    +-- The child is forked masked so the only async-exception delivery point
    308 
    +-- is the interruptible 'waitOnSemaphore'; the STM commit afterwards then
    309 
    +-- always runs to completion, so 'threadFinished' is always filled.
    310 
    +--
    311 
    +-- The (tid, threadFinished) pair is also published to 'activeChild' so
    312 
    +-- shutdown can drain the child even after the in-loop 'JobserverState'
    313 
    +-- is gone.
    265 314 
     acquireThread :: Jobserver -> IO JobserverAction
    266 
    -acquireThread (Jobserver { jSemaphore = sem, jobs = jobs_tvar }) = do
    315 
    +acquireThread (Jobserver { jSemaphore = sem, jobs = jobs_tvar, activeChild = active_tvar }) = do
    267 316 
         threadFinished_tmvar <- newEmptyTMVarIO
    268 
    -    let
    269 
    -      wait_result_action :: Either MC.SomeException Bool -> IO ()
    270 
    -      wait_result_action wait_res =
    317 
    +    tid <- MC.mask_ $ do
    318 
    +      tid <- forkIO $ do
    319 
    +        wait_res <- MC.try @_ @MC.SomeException $ waitOnSemaphore sem
    271 320 
             tracedAtomically_ "acquire_thread" do
    272 321 
               (r, jb) <- case wait_res of
    273 322 
                 Left (e :: MC.SomeException) -> do
    274 323 
                   return $ (Just e, Nothing)
    275 
    -            Right success -> do
    276 
    -              if success
    277 
    -                then do
    278 
    -                  modifyJobResources jobs_tvar \ jobs ->
    279 
    -                    return (Nothing, addToken jobs)
    280 
    -                else
    281 
    -                  return (Nothing, Nothing)
    324 
    +            Right tok -> do
    325 
    +              modifyJobResources jobs_tvar \ jobs ->
    326 
    +                return (Nothing, addToken tok jobs)
    282 327 
               putTMVar threadFinished_tmvar r
    283 328 
               return jb
    284 
    -    wait_id <- forkWaitOnSemaphoreInterruptible sem wait_result_action
    285 
    -    labelThread (waitingThreadId wait_id) "acquire_thread"
    286 
    -    return $ Acquiring { activeWaitId   = wait_id
    329 
    +      atomically $ writeTVar active_tvar (Just (tid, threadFinished_tmvar))
    330 
    +      return tid
    331 
    +    labelThread tid "acquire_thread"
    332 
    +    return $ Acquiring { activeThreadId = tid
    287 333 
                            , threadFinished = threadFinished_tmvar }
    288 334
    289 335 
     -- | Spawn a thread to release ownership of one resource from the semaphore,
    290 336 
     -- provided we have spare resources and no pending jobs.
    291 337 
     releaseThread :: Jobserver -> IO JobserverAction
    292 
    -releaseThread (Jobserver { jSemaphore = sem, jobs = jobs_tvar }) = do
    338 
    +releaseThread (Jobserver { jobs = jobs_tvar }) = do
    293 339 
       threadFinished_tmvar <- newEmptyTMVarIO
    294 340 
       MC.mask_ do
    295 341 
         -- Pre-release the resource so that another thread doesn't take control of it
    296 342 
         -- just as we release the lock on the semaphore.
    297 
    -    still_ok_to_release
    343 
    +    mb_tok
    298 344 
           <- tracedAtomically "pre_release" $
    299 345 
              modifyJobResources jobs_tvar \ jobs ->
    300 346 
                if guardRelease jobs
    301 
    -               -- TODO: should this also debounce?
    302 
    -           then return (True , removeOwnedToken $ removeFreeToken jobs)
    303 
    -           else return (False, jobs)
    304 
    -    if not still_ok_to_release
    305 
    -    then return Idle
    306 
    -    else do
    307 
    -      tid <- forkIO $ do
    308 
    -        x <- MC.try $ releaseSemaphore sem 1
    309 
    -        tracedAtomically_ "post-release" $ do
    310 
    -          (r, jobs) <- case x of
    311 
    -            Left (e :: MC.SomeException) -> do
    312 
    -              modifyJobResources jobs_tvar \ jobs ->
    313 
    -                return (Just e, addToken jobs)
    314 
    -            Right _ -> do
    315 
    -              return (Nothing, Nothing)
    316 
    -          putTMVar threadFinished_tmvar r
    317 
    -          return jobs
    318 
    -      labelThread tid "release_thread"
    319 
    -      return Idle
    347 
    +           then let (tok, jobs') = removeOwnedToken $ removeFreeToken jobs
    348 
    +                in return (Just tok, jobs')
    349 
    +           else return (Nothing, jobs)
    350 
    +    case mb_tok of
    351 
    +      Nothing ->
    352 
    +        -- Not OK to release: there are other pending jobs that could make use of the token.
    353 
    +        return Idle
    354 
    +      Just tok -> do
    355 
    +        tid <- forkIO $ do
    356 
    +          x <- MC.try @_ @MC.SomeException $ releaseSemaphoreToken tok
    357 
    +          tracedAtomically_ "post-release" $ do
    358 
    +            (r, jobs) <- case x of
    359 
    +              Left (e :: MC.SomeException) -> do
    360 
    +                modifyJobResources jobs_tvar \ jobs ->
    361 
    +                  return (Just e, addToken tok jobs)
    362 
    +              Right _ -> do
    363 
    +                return (Nothing, Nothing)
    364 
    +            putTMVar threadFinished_tmvar r
    365 
    +            return jobs
    366 
    +        labelThread tid "release_thread"
    367 
    +        return Idle
    320 368
    321 369 
     -- | When there are pending jobs but no free tokens,
    322 370 
     -- spawn a thread to acquire a new token from the semaphore.
    ... ... @@ -363,13 +411,14 @@ tryRelease _ _ = retry
    363 411 
     -- | Wait for an active thread to finish. Once it finishes:
    364 412 
     --
    365 413 
     --  - set the 'JobserverAction' to 'Idle',
    414 
    +--  - clear the 'activeChild' handle,
    366 415 
     --  - update the number of capabilities to reflect the number
    367 416 
     --    of owned tokens from the semaphore.
    368 417 
     tryNoticeIdle :: JobserverOptions
    369 
    -              -> TVar JobResources
    418 
    +              -> Jobserver
    370 419 
                   -> JobserverState
    371 420 
                   -> STM (IO JobserverState)
    372 
    -tryNoticeIdle opts jobs_tvar jobserver_state
    421 
    +tryNoticeIdle opts (Jobserver { jobs = jobs_tvar, activeChild = active_tvar }) jobserver_state
    373 422 
       | Just threadFinished_tmvar <- activeThread_maybe $ jobserverAction jobserver_state
    374 423 
       = sync_num_caps (canChangeNumCaps jobserver_state) threadFinished_tmvar
    375 424 
       | otherwise
    ... ... @@ -381,6 +430,7 @@ tryNoticeIdle opts jobs_tvar jobserver_state
    381 430 
         sync_num_caps can_change_numcaps_tvar threadFinished_tmvar = do
    382 431 
           mb_ex <- takeTMVar threadFinished_tmvar
    383 432 
           for_ mb_ex MC.throwM
    433 
    +      writeTVar active_tvar Nothing
    384 434 
           Jobs { tokensOwned } <- readTVar jobs_tvar
    385 435 
           can_change_numcaps <- readTVar can_change_numcaps_tvar
    386 436 
           guard can_change_numcaps
    ... ... @@ -404,11 +454,11 @@ tryStopThread :: TVar JobResources
    404 454 
                   -> STM (IO JobserverState)
    405 455 
     tryStopThread jobs_tvar jsj = do
    406 456 
       case jobserverAction jsj of
    407 
    -    Acquiring { activeWaitId = wait_id } -> do
    457 
    +    Acquiring { activeThreadId = tid } -> do
    408 458 
          jobs <- readTVar jobs_tvar
    409 459 
          guard $ null (jobsWaiting jobs)
    410 460 
          return do
    411 
    -       interruptWaitOnSemaphore wait_id
    461 
    +       killThread tid
    412 462 
            return $ jsj { jobserverAction = Idle }
    413 463 
         _ -> retry
    414 464
    ... ... @@ -430,30 +480,38 @@ jobserverLoop opts sjs@(Jobserver { jobs = jobs_tvar })
    430 480 
           action <- atomically $ asum $ (\x -> x s) <$>
    431 481 
             [ tryRelease    sjs
    432 482 
             , tryAcquire    opts sjs
    433 
    -        , tryNoticeIdle opts jobs_tvar
    483 
    +        , tryNoticeIdle opts sjs
    434 484 
             , tryStopThread jobs_tvar
    435 485 
             ]
    436 486 
           s <- action
    437 487 
           loop s
    438 488
    439 
    --- | Create a new jobserver using the given semaphore handle.
    440 
    -makeJobserver :: SemaphoreName -> IO (AbstractSem, IO ())
    441 
    -makeJobserver sem_name = do
    442 
    -  semaphore <- openSemaphore sem_name
    489 
    +-- | Create a new jobserver using the given semaphore identifier.
    490 
    +makeJobserver :: SemaphoreIdentifier -> IO (AbstractSem, IO ())
    491 
    +makeJobserver sem_ident = do
    492 
    +  semaphore <- openSemaphore sem_ident >>= either MC.throwM pure
    443 493 
       let
    444 494 
         init_jobs =
    445 495 
           Jobs { tokensOwned = 1
    446 496 
                , tokensFree  = 1
    447 497 
                , jobsWaiting = NilOL
    498 
    +           , heldTokens  = []
    448 499 
                }
    449 500 
       jobs_tvar <- newTVarIO init_jobs
    501 
    +  active_tvar <- newTVarIO Nothing
    450 502 
       let
    451 503 
         opts = defaultJobserverOptions -- TODO: allow this to be configured
    452 
    -    sjs = Jobserver { jSemaphore = semaphore
    453 
    -                    , jobs       = jobs_tvar }
    504 
    +    sjs = Jobserver { jSemaphore  = semaphore
    505 
    +                    , jobs        = jobs_tvar
    506 
    +                    , activeChild = active_tvar }
    454 507 
       loop_finished_mvar <- newEmptyMVar
    455 508 
       loop_tid <- forkIOWithUnmask \ unmask -> do
    456 509 
         r <- try $ unmask $ jobserverLoop opts sjs
    510 
    +    -- Always-run exit handler: any child the loop spawned is still alive
    511 
    +    -- in its own thread, so drain it before touching jobs_tvar. No one
    512 
    +    -- else can mutate the resources once both are dead.
    513 
    +    drainActiveChild sjs
    514 
    +    releaseAllHeld sjs
    457 515 
         putMVar loop_finished_mvar $
    458 516 
           case r of
    459 517 
             Left e
    ... ... @@ -467,8 +525,8 @@ makeJobserver sem_name = do
    467 525 
         acquireSem = acquireJob jobs_tvar
    468 526 
         releaseSem = releaseJob jobs_tvar
    469 527 
         cleanupSem = do
    470 
    -      -- this is interruptible
    471 
    -      cleanupJobserver sjs
    528 
    +      -- Trigger the loop's exit handler; it drains the active child and
    529 
    +      -- releases all held tokens, then signals loop_finished_mvar.
    472 530 
           killThread loop_tid
    473 531 
           mb_ex <- takeMVar loop_finished_mvar
    474 532 
           for_ mb_ex MC.throwM
    ... ... @@ -477,12 +535,12 @@ makeJobserver sem_name = do
    477 535
    478 536 
     -- | Implement an abstract semaphore using a semaphore 'Jobserver'
    479 537 
     -- which queries the system semaphore of the given name for resources.
    480 
    -runJSemAbstractSem :: SemaphoreName         -- ^ the system semaphore to use
    538 
    +runJSemAbstractSem :: SemaphoreIdentifier   -- ^ the semaphore identifier (from @-jsem@)
    481 539 
                        -> (AbstractSem -> IO a) -- ^ the operation to run
    482 540 
                                                 -- which requires a semaphore
    483 541 
                        -> IO a
    484 
    -runJSemAbstractSem sem action = MC.mask \ unmask -> do
    485 
    -  (abs, cleanup) <- makeJobserver sem
    542 
    +runJSemAbstractSem sem_ident action = MC.mask \ unmask -> do
    543 
    +  (abs, cleanup) <- makeJobserver sem_ident
    486 544 
       r <- try $ unmask $ action abs
    487 545 
       case r of
    488 546 
         Left (e1 :: MC.SomeException) -> do
    ... ... @@ -517,8 +575,13 @@ increases the number of `free` jobs. If there are more pending jobs when the fre
    517 575 
     is increased, the token is immediately reused (see `modifyJobResources`).
    518 576
    519 577 
     The `jobServerLoop` interacts with the system semaphore: when there are pending
    520 
    -jobs, `acquireThread` blocks, waiting for a token from the semaphore. Once a
    521 
    -token is obtained, it increases the owned count.
    578 
    +jobs, `acquireThread` forks a child that calls the interruptible
    579 
    +`waitOnSemaphore`. The child is forked in the masked state, so the only place
    580 
    +an async exception can be delivered is the wait itself; once the wait returns,
    581 
    +the child's STM commit always completes, recording either the new token in
    582 
    +`heldTokens` or the failure exception in `threadFinished`. The (tid, tmvar)
    583 
    +pair is also published in `activeChild` so the loop's exit handler can drain
    584 
    +the child on shutdown even after the in-loop `JobserverState` is gone.
    522 585
    523 586 
     When GHC has free tokens (tokens from the semaphore that it is not using),
    524 587 
     no pending jobs, and the debounce has expired, then `releaseThread` will
    ... ... @@ -531,6 +594,12 @@ This second token is no longer needed, so we should cancel the wait
    531 594 
     (as it would not be used to do any work, and not be returned until the debounce).
    532 595 
     We only need to kill `acquireJob`, because `releaseJob` never blocks.
    533 596
    597 
    +Shutdown starts with `killThread loop_tid`. The loop's exit handler then
    598 
    +runs `drainActiveChild` followed by `releaseAllHeld`; only then does the
    599 
    +loop signal `loop_finished_mvar`. This sequence makes the heldTokens
    600 
    +snapshot consistent because no other thread can mutate it once the loop and
    601 
    +its child are both dead.
    602 
    +
    534 603 
     Note [Eventlog Messages for jsem]
    535 604 
     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    536 605 
     It can be tricky to verify that the work is shared adequately across different
    ... ... @@ -540,3 +609,5 @@ to analyse this output and report statistics about core saturation in the
    540 609 
     GitHub repo (https://github.com/mpickering/ghc-jsem-analyse).
    541 610
    542 611 
     -}
    612 
    +
    613 
    +#endif

  • compiler/GHC/Driver/Session.hs
    ... ... @@ -289,6 +289,8 @@ import GHC.SysTools.BaseDir ( expandToolDir, expandTopDir )
    289 289 
     import GHC.Toolchain
    290 290 
     import GHC.Toolchain.Program
    291 291
    292 
    +import System.Semaphore ( getSemaphoreProtocolVersion, semaphoreVersion )
    293 
    +
    292 294 
     import Data.IORef
    293 295 
     import Control.Arrow ((&&&))
    294 296 
     import Control.Monad
    ... ... @@ -2445,6 +2447,7 @@ wWarningFlagsDeps = [minBound..maxBound] >>= \x -> case x of
    2445 2447 
       Opt_WarnUnusableUnpackPragmas -> warnSpec x
    2446 2448 
       Opt_WarnPatternNamespaceSpecifier -> warnSpec x
    2447 2449 
       Opt_WarnUnrecognisedModifiers -> warnSpec x
    2450 
    +  Opt_WarnSemaphoreOpenFailure -> warnSpec x
    2448 2451
    2449 2452 
     warningGroupsDeps :: [(Deprecation, FlagSpec WarningGroup)]
    2450 2453 
     warningGroupsDeps = map mk warningGroups
    ... ... @@ -3628,6 +3631,8 @@ compilerInfo dflags
    3628 3631 
            ("Support dynamic-too",         showBool $ not isWindows),
    3629 3632 
            -- Whether or not we support the @-j@ flag with @--make@.
    3630 3633 
            ("Support parallel --make",     "YES"),
    3634 
    +       -- The semaphore protocol version supported by @-jsem@.
    3635 
    +       ("Semaphore version",           show (getSemaphoreProtocolVersion semaphoreVersion)),
    3631 3636 
            -- Whether or not we support "Foo from foo-0.1-XXX:Foo" syntax in
    3632 3637 
            -- installed package info.
    3633 3638 
            ("Support reexported-modules",  "YES"),

  • compiler/GHC/Types/Error/Codes.hs
    ... ... @@ -403,6 +403,7 @@ type family GhcDiagnosticCode c = n | n -> c where
    403 403 
       GhcDiagnosticCode "DriverInstantiationNodeInDependencyGeneration" = 74284
    404 404 
       GhcDiagnosticCode "DriverNoConfiguredLLVMToolchain"               = 66599
    405 405 
       GhcDiagnosticCode "DriverMissingLinkableForModule"                = 47338
    406 
    +  GhcDiagnosticCode "DriverSemaphoreOpenFailure"                    = 19877
    406 407
    407 408 
       -- Constraint solver diagnostic codes
    408 409 
       GhcDiagnosticCode "BadTelescope"                                  = 97739

  • compiler/GHC/Types/Hint.hs
    ... ... @@ -11,6 +11,7 @@ module GHC.Types.Hint (
    11 11 
       , StarIsType(..)
    12 12 
       , UntickedPromotedThing(..)
    13 13 
       , AssumedDerivingStrategy(..)
    14 
    +  , SemaphoreUpgradeTarget(..)
    14 15 
       , SigLike(..)
    15 16 
       , pprUntickedConstructor, isBareSymbol
    16 17 
       , suggestExtension
    ... ... @@ -538,6 +539,28 @@ data GhcHint
    538 539 
       {-| Suggest adding signature to modifier -}
    539 540 
       | SuggestModifierSignature (HsModifier GhcRn) Name
    540 541
    542 
    +  {-| Suggest upgrading either the @-jsem@ jobserver or GHC itself to
    543 
    +      support the given semaphore protocol version.
    544 
    +
    545 
    +      Triggered by 'GHC.Driver.Errors.Types.DriverSemaphoreOpenFailure'
    546 
    +      carrying a 'System.Semaphore.SemaphoreIncompatibleVersion'.
    547 
    +  -}
    548 
    +  | SuggestUpgradeForSemaphoreVersionMismatch !SemaphoreUpgradeTarget !Int
    549 
    +    -- ^ The 'Int' is the required protocol version.
    550 
    +
    551 
    +-- | What the user should upgrade to resolve an @-jsem@ semaphore
    552 
    +--   protocol version mismatch.
    553 
    +data SemaphoreUpgradeTarget
    554 
    +  = UpgradeCabalInstall
    555 
    +    -- ^ Jobserver is @cabal-install@ (we are building a Cabal package)
    556 
    +    --   and speaks an older protocol than GHC.
    557 
    +  | UpgradeJobserver
    558 
    +    -- ^ Jobserver (not @cabal-install@) speaks an older protocol than
    559 
    +    --   GHC.
    560 
    +  | UpgradeGHC
    561 
    +    -- ^ Jobserver speaks a newer protocol than GHC.
    562 
    +  deriving (Eq, Show)
    563 
    +
    541 564 
     -- | The deriving strategy that was assumed when not explicitly listed in the
    542 565 
     --   source. This is used solely by the missing-deriving-strategies warning.
    543 566 
     --   There's no `Via` case because we never assume that.

  • compiler/GHC/Types/Hint/Ppr.hs
    ... ... @@ -306,6 +306,20 @@ instance Outputable GhcHint where
    306 306 
                (text "Perhaps it should have a kind signature, like")
    307 307 
                2
    308 308 
                (hsep [text "%(" <> ppr ty, text "::", ppr name <> text ")"])
    309 
    +    SuggestUpgradeForSemaphoreVersionMismatch target required
    310 
    +      -> case target of
    311 
    +           UpgradeCabalInstall ->
    312 
    +                 text "The cabal-install jobserver uses an older semaphore protocol."
    313 
    +              $$ (text "Upgrade cabal-install to a version that supports semaphore protocol v"
    314 
    +                  <> int required <> text " to resolve this.")
    315 
    +           UpgradeJobserver ->
    316 
    +                 text "The jobserver uses an older semaphore protocol."
    317 
    +              $$ (text "Upgrade it to a version that supports semaphore protocol v"
    318 
    +                  <> int required <> text " to resolve this.")
    319 
    +           UpgradeGHC ->
    320 
    +                 text "The jobserver uses a newer semaphore protocol than this GHC."
    321 
    +              $$ (text "Upgrade GHC to a version that supports semaphore protocol v"
    322 
    +                  <> int required <> text " to resolve this.")
    309 323
    310 324 
     perhapsAsPat :: SDoc
    311 325 
     perhapsAsPat = text "Perhaps you meant an as-pattern, which must not be surrounded by whitespace"

  • docs/users_guide/using-warnings.rst
    ... ... @@ -2721,6 +2721,23 @@ of ``-W(no-)*``.
    2721 2721 
           f :: a %True -> a
    2722 2722 
           g :: a %(k :: Int) -> a
    2723 2723
    2724 
    +.. ghc-flag:: -Wsemaphore-open-failure
    2725 
    +    :shortdesc: warn when GHC cannot open the ``-jsem`` semaphore.
    2726 
    +    :type: dynamic
    2727 
    +    :reverse: -Wno-semaphore-open-failure
    2728 
    +    :category:
    2729 
    +
    2730 
    +    :since: 10.0.1
    2731 
    +
    2732 
    +    Warn when GHC is invoked with :ghc-flag:`-jsem` but the semaphore
    2733 
    +    cannot be opened (e.g. the socket does not exist, the protocol
    2734 
    +    version is incompatible, or a system error occurred).  When this
    2735 
    +    occurs, GHC ignores ``-jsem`` and compiles modules sequentially.
    2736 
    +
    2737 
    +    A common cause is ``cabal-install`` and GHC being built against
    2738 
    +    different versions of the ``semaphore-compat`` library; upgrading
    2739 
    +    both to versions that use the same protocol resolves the mismatch.
    2740 
    +
    2724 2741 
     ----
    2725 2742
    2726 2743 
     If you're feeling really paranoid, the :ghc-flag:`-dcore-lint` option is a good choice.

  • docs/users_guide/using.rst
    ... ... @@ -797,7 +797,12 @@ There are two kinds of participants in the GHC Jobserver protocol:
    797 797
    798 798 
         Perform compilation in parallel when possible, coordinating with other
    799 799 
         processes through the semaphore ⟨sem⟩ (specified as a string).
    800 
    -    Error if the semaphore doesn't exist.
    800 
    +
    801 
    +    If the semaphore cannot be opened (e.g. the socket does not exist
    802 
    +    or its protocol version is incompatible with this GHC), GHC emits
    803 
    +    a :ghc-flag:`-Wsemaphore-open-failure` warning and compiles
    804 
    +    sequentially, using only the implicit token inherited from the
    805 
    +    parent process.
    801 806
    802 807 
         Use of ``-jsem`` will override use of :ghc-flag:`-j[⟨n⟩]`,
    803 808 
         and vice-versa.

  • hadrian/src/Flavour.hs
    ... ... @@ -149,10 +149,6 @@ werror =
    149 149 
                 -- unix has many unused imports
    150 150 
               , package unix
    151 151 
                   ? mconcat [arg "-Wwarn=unused-imports", arg "-Wwarn=unused-top-binds"]
    152 
    -            -- semaphore-compat relies on sem_getvalue as provided by unix, which is
    153 
    -            -- not implemented on Darwin and therefore throws a deprecation warning
    154 
    -          , package semaphoreCompat
    155 
    -              ? mconcat [arg "-Wwarn=deprecations"]
    156 152 
               ]
    157 153 
         , builder Ghc
    158 154 
             ? package rts

  • libraries/semaphore-compat
    1 
    -Subproject commit 7929702401d49bc64d809c501ed5fe80aebc3cc1
    1 
    +Subproject commit baa6d17eadcb88f5b0300dfaf6ca510374ffc8e7

  • testsuite/tests/diagnostic-codes/codes.stdout
    ... ... @@ -21,6 +21,7 @@
    21 21 
     [GHC-29747] is untested (constructor = DriverMissingSafeHaskellMode)
    22 22 
     [GHC-74284] is untested (constructor = DriverInstantiationNodeInDependencyGeneration)
    23 23 
     [GHC-66599] is untested (constructor = DriverNoConfiguredLLVMToolchain)
    24 
    +[GHC-19877] is untested (constructor = DriverSemaphoreOpenFailure)
    24 25 
     [GHC-81325] is untested (constructor = ExpectingMoreArguments)
    25 26 
     [GHC-78125] is untested (constructor = AmbiguityPreventsSolvingCt)
    26 27 
     [GHC-84170] is untested (constructor = TcRnModMissingRealSrcSpan)

    • —
    View it on GitLab.
    You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications · Help