David Eichmann pushed to branch wip/davide/hadrian_avoid_response_files_2 at Glasgow Haskell Compiler / GHC Commits: ff6d11f9 by David Eichmann at 2026-06-03T15:03:06+01:00 Hadrian: always keep response files Now that response files are only used in a small number of cases, it's resonable to keep all response files by default and simply remove the -r / --keep-response-files command line options. The response file paths are nolonger randomized. They are placed in the build directory next to command output files.This ensures we reuse file paths when rebuilding rather than leaving stale response files around. - - - - - 4 changed files: - hadrian/src/Builder.hs - hadrian/src/CommandLine.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 @@ -352,6 +352,7 @@ instance H.Builder Builder where -- empty arguments (such as the -dep-suffix flag), but that isn't supported -- yet due to #26560. withResponseFileIfLongCmd + output (toCmdArgument [path] <> toCmdArgument buildArgs) buildInputs (toCmdArgument buildOptions) @@ -390,11 +391,13 @@ 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 = withResponseFileIfLongCmd +runHaddock outputFilePath haddockPath flagArgs fileInputs = withResponseFileIfLongCmd + outputFilePath (toCmdArgument [haddockPath] <> toCmdArgument flagArgs) fileInputs (CmdArgument []) ===================================== hadrian/src/CommandLine.hs ===================================== @@ -3,8 +3,7 @@ module CommandLine ( lookupBignum, cmdBignum, cmdProgressInfo, cmdCompleteSetting, cmdDocsArgs, cmdUnitIdHash, lookupBuildRoot, TestArgs(..), TestSpeed(..), defaultTestArgs, - cmdPrefix, cmdChangelogVersion, DocArgs(..), defaultDocArgs, - cmdKeepResponseFiles + cmdPrefix, cmdChangelogVersion, DocArgs(..), defaultDocArgs ) where import Data.Either @@ -12,7 +11,7 @@ import qualified Data.HashMap.Strict as Map import Data.List.Extra import Development.Shake hiding (Normal) import Flavour (DocTargets, DocTarget(..)) -import Hadrian.Utilities hiding (buildRoot, keepResponseFiles) +import Hadrian.Utilities hiding (buildRoot) import Settings.Parser import System.Console.GetOpt import System.Environment @@ -37,7 +36,6 @@ data CommandLineArgs = CommandLineArgs , testArgs :: TestArgs , docsArgs :: DocArgs , docTargets :: DocTargets - , keepResponseFiles :: Bool , prefix :: Maybe FilePath , changelogVersion :: Maybe String , completeStg :: Maybe String } @@ -58,7 +56,6 @@ defaultCommandLineArgs = CommandLineArgs , testArgs = defaultTestArgs , docsArgs = defaultDocArgs , docTargets = Set.fromList [minBound..maxBound] - , keepResponseFiles = False , prefix = Nothing , changelogVersion = Nothing , completeStg = Nothing } @@ -141,9 +138,6 @@ readFreeze1 = Right $ \flags -> flags { freeze1 = True } readFreeze2 = Right $ \flags -> flags { freeze1 = True, freeze2 = True } readSkipDepends = Right $ \flags -> flags { skipDepends = True } -readKeepResponseFiles :: Either String (CommandLineArgs -> CommandLineArgs) -readKeepResponseFiles = Right $ \flags -> flags { keepResponseFiles = True } - readUnitIdHash :: Either String (CommandLineArgs -> CommandLineArgs) readUnitIdHash = Right $ \flags -> trace "--hash-unit-ids is deprecated. It is enabled by release flavour or +hash_unit_ids flavour transformer" $ @@ -302,8 +296,6 @@ optDescrs = "Progress info style (None, Brief, Normal or Unicorn)." , Option [] ["docs"] (ReqArg readDocsArg "TARGET") "Strip down docs targets (none, no-haddocks, no-sphinx[-{html, pdfs, man}]." - , Option ['r'] ["keep-response-files"] (NoArg readKeepResponseFiles) - "Keep response files created during the build (for debugging)." , Option ['k'] ["keep-test-files"] (NoArg readTestKeepFiles) "Keep all the files generated when running the testsuite." , Option [] ["test-compiler"] (ReqArg readTestCompiler "TEST_COMPILER") @@ -382,7 +374,6 @@ cmdLineArgsMap = do return $ insertExtra (progressInfo args) -- Accessed by Hadrian.Utilities $ insertExtra (buildRoot args) -- Accessed by Hadrian.Utilities - $ insertExtra (KeepResponseFiles $ keepResponseFiles args) -- Accessed by Hadrian.Utilities $ insertExtra (testArgs args) -- Accessed by Settings.Builders.RunTest $ insertExtra (docsArgs args) -- Accessed by Rules.Documentation $ insertExtra allSettings -- Accessed by Settings @@ -424,9 +415,6 @@ cmdUnitIdHash = unitIdHash <$> cmdLineArgs cmdBignum :: Action (Maybe String) cmdBignum = bignum <$> cmdLineArgs -cmdKeepResponseFiles :: Action Bool -cmdKeepResponseFiles = keepResponseFiles <$> cmdLineArgs - cmdProgressInfo :: Action ProgressInfo cmdProgressInfo = progressInfo <$> cmdLineArgs ===================================== hadrian/src/Hadrian/Builder/Ar.hs ===================================== @@ -23,6 +23,7 @@ import Development.Shake import Development.Shake.Classes import GHC.Generics import Hadrian.Utilities +import System.FilePath ((<.>)) -- | We support packing and unpacking archives with @ar@. data ArMode = Pack | Unpack deriving (Eq, Generic, Show) @@ -35,14 +36,16 @@ 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 - writeFile' tmp $ unwords fileArgs - cmd [arPath] flagArgs ('@' : tmp) buildOptions +runAr outputFilePath arPath flagArgs fileArgs buildOptions = do + let rspFile = outputFilePath <.> "rsp" + writeFile' rspFile $ unwords fileArgs + cmd [arPath] flagArgs ('@' : rspFile) buildOptions -- | Invoke @ar@ given a path to it and a list of arguments. Note that @ar@ -- will be called multiple times if the list of files to be archived is too ===================================== hadrian/src/Hadrian/Utilities.hs ===================================== @@ -16,7 +16,7 @@ module Hadrian.Utilities ( -- * Paths BuildRoot (..), buildRoot, buildRootRules, isGeneratedSource, - KeepResponseFiles (..), keepResponseFiles, withResponseFile, withResponseFileIfLongCmd, + withResponseFileIfLongCmd, -- * File system operations copyFile, copyFileUntracked, createFileLink, fixFile, @@ -52,7 +52,6 @@ import Development.Shake.Classes import Development.Shake.FilePath import GHC.ResponseFile (escapeArgs) import System.Environment (lookupEnv) -import System.IO (hClose, openTempFile) import System.IO.Error (isPermissionError) import qualified Data.ByteString as BS @@ -323,59 +322,28 @@ buildRootRules = do isGeneratedSource :: FilePath -> Action Bool isGeneratedSource file = buildRoot <&> (`isPrefixOf` file) -newtype KeepResponseFiles = KeepResponseFiles Bool deriving (Eq, Show) - --- | Whether to retain response files after the build action that created them --- completes. Mainly useful for debugging. -keepResponseFiles :: Action Bool -keepResponseFiles = do - KeepResponseFiles keep <- userSetting (KeepResponseFiles False) - return keep - -- | 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) withResponseFileIfLongCmd :: (CmdResult c) => - CmdArgument -- ^ Command and arguments before the response file arguments. + FilePath -- ^ Command output file. The reponse file is placed next to this + -> CmdArgument -- ^ Command and arguments before the response file arguments. -> [String] -- ^ Response file aruguments. -> CmdArgument -- ^ Command arguments after the response file arguments. -> Action c -withResponseFileIfLongCmd argsPre argsResp argsPost = do +withResponseFileIfLongCmd outputFilePath argsPre argsResp argsPost = do let cmdLineLengh = sum [ 1 + length arg -- add one to account for space inbetween arguments | let CmdArgument args = argsPre <> toCmdArgument argsResp <> argsPost , Right arg <- args ] - if cmdLineLengh >= cmdLineLengthLimit - then withResponseFile $ \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 - keep <- keepResponseFiles - let putVerboseResponseFile tmp = do - verbosity <- getVerbosity - when (verbosity >= Verbose) $ do - tmpContent <- liftIO (readFile tmp) - putVerbose (tmp <> " (use hadrian flag --keep-response-files to keep this file):\n" <> tmpContent) - if keep - then do - (tmp, h) <- liftIO $ openTempFile "." "hadrian-rsp" - liftIO $ hClose h - putInfo $ "Keeping response file: " ++ tmp - result <- action tmp - putVerboseResponseFile tmp - return result - else withTempFile $ \tmp -> do - result <- action tmp - putVerboseResponseFile tmp - return result + if cmdLineLengh < cmdLineLengthLimit + then cmd argsPre argsResp argsPost + else do + let rspFile = outputFilePath <.> "rsp" + writeFile' rspFile (escapeArgs argsResp) + cmd argsPre ['@' : rspFile] argsPost -- | Link a file tracking the link target. Create the target directory if -- missing. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ff6d11f9858c49dd70d4b01eed5e3b58... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ff6d11f9858c49dd70d4b01eed5e3b58... You're receiving this email because of your account on gitlab.haskell.org.