David Eichmann pushed to branch wip/davide/hadrian_avoid_response_files_2 at Glasgow Haskell Compiler / GHC Commits: aea1d1d8 by David Eichmann at 2026-06-02T12:27:26+01:00 Hadrian: avoid response files when command line is short enough This replaces the logic of always using response files on Windows. With the new condition based on command line lenght, reponse files can be avoided in many more cases (on windows). - - - - - 3 changed files: - hadrian/src/Builder.hs - hadrian/src/Hadrian/Builder/Ar.hs - hadrian/src/Hadrian/Utilities.hs Changes: ===================================== hadrian/src/Builder.hs ===================================== @@ -304,7 +304,7 @@ instance H.Builder Builder where case builder of Ar Pack stg -> do useTempFile <- arSupportsAtFile stg - if useTempFile then runAr path buildArgs buildInputs buildOptions + if useTempFile then runAr output path buildArgs buildInputs buildOptions else runArWithoutTempFile path buildArgs buildInputs buildOptions Ar Unpack _ -> cmd' [Cwd output] [path] buildArgs buildOptions @@ -343,7 +343,7 @@ instance H.Builder Builder where Exit _ <- cmd' [path] (buildArgs ++ [input]) buildOptions return () - Haddock BuildPackage -> runHaddock path buildArgs buildInputs + Haddock BuildPackage -> runHaddock output path buildArgs buildInputs Ghc _ _ -> -- Use a response file for ghc invocations to avoid issues with command line @@ -351,9 +351,11 @@ instance H.Builder Builder where -- NB: we can't put the buildArgs in a response file, because some flags require -- empty arguments (such as the -dep-suffix flag), but that isn't supported -- yet due to #26560. - withResponseFileOnWindows - (\buildInputs' -> cmd [path] buildArgs buildInputs' buildOptions) + withResponseFileIfLongCmd + output + (toCmdArgument path <> toCmdArgument buildArgs) buildInputs + (toCmdArgument buildOptions) HsCpp -> captureStdout @@ -389,13 +391,16 @@ instance H.Builder Builder where -- | Invoke @haddock@ given a path to it and a list of arguments. On Windows, -- the input file arguments are passed as a response file. -runHaddock :: FilePath -- ^ path to @haddock@ +runHaddock :: FilePath -- ^ output file path + -> FilePath -- ^ path to @haddock@ -> [String] -> [FilePath] -- ^ input file paths -> Action () -runHaddock haddockPath flagArgs fileInputs = withResponseFileOnWindows - (cmd [haddockPath] flagArgs) +runHaddock outputFilePath haddockPath flagArgs fileInputs = withResponseFileIfLongCmd + outputFilePath + (toCmdArgument haddockPath <> toCmdArgument flagArgs) fileInputs + (CmdArgument []) -- TODO: Some builders are required only on certain platforms. For example, -- 'Objdump' is only required on OpenBSD and AIX. Add support for platform ===================================== hadrian/src/Hadrian/Builder/Ar.hs ===================================== @@ -35,12 +35,13 @@ instance NFData ArMode -- to be archived is passed via a temporary response file. Passing arguments -- via a response file is not supported by some versions of @ar@, in which -- case you should use 'runArWithoutTempFile' instead. -runAr :: FilePath -- ^ path to @ar@ +runAr :: FilePath -- ^ Output file path + -> FilePath -- ^ path to @ar@ -> [String] -- ^ other arguments -> [FilePath] -- ^ input file paths -> [CmdOption] -- ^ Additional options -> Action () -runAr arPath flagArgs fileArgs buildOptions = withResponseFile $ \tmp -> do +runAr outputFile arPath flagArgs fileArgs buildOptions = withResponseFile outputFile $ \tmp -> do writeFile' tmp $ unwords fileArgs cmd [arPath] flagArgs ('@' : tmp) buildOptions ===================================== hadrian/src/Hadrian/Utilities.hs ===================================== @@ -1,4 +1,6 @@ +{-# LANGUAGE ImpredicativeTypes #-} {-# LANGUAGE TypeFamilies #-} + module Hadrian.Utilities ( -- * List manipulation fromSingleton, replaceEq, minusOrd, intersectOrd, lookupAll, chunksOfSize, @@ -14,7 +16,7 @@ module Hadrian.Utilities ( -- * Paths BuildRoot (..), buildRoot, buildRootRules, isGeneratedSource, - KeepResponseFiles (..), keepResponseFiles, withResponseFile, withResponseFileOnWindows, + KeepResponseFiles (..), keepResponseFiles, withResponseFile, withResponseFileIfLongCmd, -- * File system operations copyFile, copyFileUntracked, createFileLink, fixFile, @@ -50,7 +52,6 @@ import Development.Shake.Classes import Development.Shake.FilePath import GHC.ResponseFile (escapeArgs) import System.Environment (lookupEnv) -import System.Info.Extra (isWindows) import System.IO (hClose, openTempFile) import System.IO.Error (isPermissionError) @@ -61,6 +62,7 @@ import qualified System.Directory.Extra as IO import qualified System.Info.Extra as IO import qualified System.IO as IO import qualified System.FilePath.Posix as Posix +import Development.Shake.Command (CmdArgument (..), IsCmdArgument (toCmdArgument)) -- | Extract a value from a singleton list, or terminate with an error message -- if the list does not contain exactly one value. @@ -330,26 +332,33 @@ keepResponseFiles = do KeepResponseFiles keep <- userSetting (KeepResponseFiles False) return keep --- | Run an action either with command arguments direcly or by, on Windows, --- placing those arguments into a response file escaped with @GHC.ResponseFile.escapeArgs@. +-- | Run an command with the given arguments. If the command is too long then the +-- response file arguments are placed into a response file and escaped with @GHC.ResponseFile.escapeArgs@. -- -- With @--keep-response-files@, the file is left on disk (if used) -withResponseFileOnWindows :: - ([String] -> Action a) -- ^ Action to perform given arguments (of the form @["\@reponseFilePath"]@ on Windows) - -> [String] -- ^ Command arguments - -> Action a -withResponseFileOnWindows action commandArgs = do - if isWindows - then withResponseFile $ \tmp -> do - writeFile' tmp (escapeArgs commandArgs) - action ['@' : tmp] - else action commandArgs +withResponseFileIfLongCmd :: (CmdResult c) => + FilePath -- ^ Output file path. The response file is kept next to this with extension .rsp. + -> CmdArgument -- ^ Command and arguments before the response file arguments. + -> [String] -- ^ Response file aruguments. + -> CmdArgument -- ^ Command arguments after the response file arguments. + -> Action c +withResponseFileIfLongCmd outputFile argsPre argsResp argsPost = do + let cmdLineLengh = sum + [ length arg + | let CmdArgument args = argsPre <> toCmdArgument argsResp <> argsPost + , Right arg <- args + ] + if cmdLineLengh >= cmdLineLengthLimit + then withResponseFile outputFile $ \tmp -> do + writeFile' tmp (escapeArgs argsResp) + cmd argsPre ('@' : tmp) argsPost + else cmd argsPre argsResp argsPost -- | Run an action with a response file path. -- -- With @--keep-response-files@, the file is left on disk. -withResponseFile :: (FilePath -> Action a) -> Action a -withResponseFile action = do +withResponseFile :: FilePath -> (FilePath -> Action a) -> Action a +withResponseFile outputFile action = do keep <- keepResponseFiles let putVerboseResponseFile tmp = do verbosity <- getVerbosity @@ -358,7 +367,9 @@ withResponseFile action = do putVerbose (tmp <> " (use hadrian flag --keep-response-files to keep this file):\n" <> tmpContent) if keep then do - (tmp, h) <- liftIO $ openTempFile "." "hadrian-rsp" + let dir = takeDirectory outputFile + file = takeFileName outputFile <.> "rsp" + (tmp, h) <- liftIO $ openTempFile dir file liftIO $ hClose h putInfo $ "Keeping response file: " ++ tmp result <- action tmp View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/aea1d1d8d26c101990eb1af1f36ae22d... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/aea1d1d8d26c101990eb1af1f36ae22d... You're receiving this email because of your account on gitlab.haskell.org.