ghc-toolchain: Configure Cpp and HsCpp correctly when user specifies flags

In ghc-toolchain, we were only /not/ configuring required flags when the
user specified any flags at all for the  of the HsCpp and Cpp tools.

Otherwise, the linker takes into consideration the user specified flags
to determine whether to search for a better linker implementation, but
already configured the remaining GHC and platform-specific flags
regardless of the user options.

Other Tools consider the user options as a baseline for further
configuration (see `findProgram`), so #23689 is not applicable.

Closes #23689

utils/ghc-toolchain/src/GHC/Toolchain/Program.hs

@@ -2,6 +2,7 @@ module GHC.Toolchain.Program
     ( Program(..)
     , _prgPath
     , _prgFlags
+    , addFlagIfNew
       -- * Running programs
     , runProgram
     , callProgram
@@ -10,6 +11,7 @@ module GHC.Toolchain.Program
       -- * Finding 'Program's
     , ProgOpt(..)
     , emptyProgOpt
+    , programFromOpt
     , _poPath
     , _poFlags
     , findProgram
@@ -46,6 +48,13 @@ _prgPath = Lens prgPath (\x o -> o {prgPath = x})
 _prgFlags :: Lens Program [String]
 _prgFlags = Lens prgFlags (\x o -> o {prgFlags = x})
 
+-- | Prepends a flag to a program's flags if the flag is not in the existing flags.
+addFlagIfNew :: String -> Program -> Program
+addFlagIfNew flag prog@(Program path flags)
+  = if flag `elem` flags
+       then prog
+       else Program path (flags ++ [flag])
+
 runProgram :: Program -> [String] -> M ExitCode
 runProgram prog args = do
     logExecute prog args
@@ -103,6 +112,14 @@ _poFlags = Lens poFlags (\x o -> o {poFlags=x})
 emptyProgOpt :: ProgOpt
 emptyProgOpt = ProgOpt Nothing Nothing
 
+-- | Make a @'Program'@ from user specified program options (@'ProgOpt'@),
+-- defaulting to the given path and flags if unspecified in the @'ProgOpt'@.
+programFromOpt :: ProgOpt
+               -> FilePath -- ^ Program path to default to
+               -> [String] -- ^ Program flags to default to
+               -> Program
+programFromOpt userSpec path flags = Program { prgPath = fromMaybe path (poPath userSpec), prgFlags = fromMaybe flags (poFlags userSpec) }
+
 -- | Tries to find the user specified program by path or tries to look for one
 -- in the given list of candidates.
 --

utils/ghc-toolchain/src/GHC/Toolchain/Tools/Cpp.hs

@@ -24,17 +24,14 @@ newtype HsCpp = HsCpp { hsCppProgram :: Program
 
 findHsCpp :: ProgOpt -> Cc -> M HsCpp
 findHsCpp progOpt cc = checking "for Haskell C preprocessor" $ do
-  -- Use the specified HS CPP or try to use the c compiler
-  foundHsCppProg <- findProgram "Haskell C preprocessor" progOpt [] <|> pure (Program (prgPath $ ccProgram cc) [])
-  case poFlags progOpt of
-    -- If the user specified HS CPP flags don't second-guess them
-    Just _ -> return HsCpp{hsCppProgram=foundHsCppProg}
-    -- Otherwise, configure the HS CPP flags for this CPP program
-    Nothing -> do
-      let rawHsCppProgram = over _prgFlags (["-E"]++) foundHsCppProg
-      hppArgs <- findHsCppArgs rawHsCppProgram
-      let hsCppProgram = over _prgFlags (++hppArgs) rawHsCppProgram
-      return HsCpp{hsCppProgram}
+  -- Use the specified Hs Cpp or try to use the c compiler
+  foundHsCppProg <- findProgram "Haskell C preprocessor" progOpt [] <|> pure (programFromOpt progOpt (prgPath $ ccProgram cc) [])
+  -- Always add the -E flag to the CPP, regardless of the user options
+  let rawHsCppProgram = addFlagIfNew "-E" foundHsCppProg
+  -- Always try to add the Haskell-specific CPP flags, regardless of the user options
+  hppArgs <- findHsCppArgs rawHsCppProgram
+  let hsCppProgram = over _prgFlags (++hppArgs) rawHsCppProgram
+  return HsCpp{hsCppProgram}
 
 -- | Given a C preprocessor, figure out how it should be invoked to preprocess
 -- Haskell source.
@@ -85,12 +82,8 @@ findHsCppArgs cpp = withTempDir $ \dir -> do
 findCpp :: ProgOpt -> Cc -> M Cpp
 findCpp progOpt cc = checking "for C preprocessor" $ do
   -- Use the specified CPP or try to use the c compiler
-  foundCppProg <- findProgram "C preprocessor" progOpt [] <|> pure (Program (prgPath $ ccProgram cc) [])
-  case poFlags progOpt of
-    -- If the user specified CPP flags don't second-guess them
-    Just _ -> return Cpp{cppProgram=foundCppProg}
-    -- Otherwise, configure the CPP flags for this CPP program
-    Nothing -> do
-      let cppProgram = over _prgFlags (["-E"]++) foundCppProg
-      return Cpp{cppProgram}
+  foundCppProg <- findProgram "C preprocessor" progOpt [] <|> pure (programFromOpt progOpt (prgPath $ ccProgram cc) [])
+  -- Always add the -E flag to the CPP, regardless of the user options
+  let cppProgram = addFlagIfNew "-E" foundCppProg
+  return Cpp{cppProgram}
 

utils/ghc-toolchain/src/GHC/Toolchain/Tools/Link.hs

@@ -47,7 +47,7 @@ findCcLink :: String -- ^ The llvm target to use if CcLink supports --target
            -> ArchOS -> Cc -> Maybe Readelf -> M CcLink
 findCcLink target progOpt ldOverride archOs cc readelf = checking "for C compiler for linking command" $ do
   -- Use the specified linker or try using the C compiler
-  rawCcLink <- findProgram "C compiler for linking" progOpt [] <|> pure (Program (prgPath $ ccProgram cc) [])
+  rawCcLink <- findProgram "C compiler for linking" progOpt [] <|> pure (programFromOpt progOpt (prgPath $ ccProgram cc) [])
   ccLinkProgram <- case poFlags progOpt of
                      Just _ ->
                          -- If the user specified linker flags don't second-guess them