| ... |
... |
@@ -345,12 +345,16 @@ instance H.Builder Builder where |
|
345
|
345
|
|
|
346
|
346
|
Haddock BuildPackage -> runHaddock path buildArgs buildInputs
|
|
347
|
347
|
|
|
348
|
|
- Ghc FindHsDependencies _ -> do
|
|
349
|
|
- -- Use a response file for ghc -M invocations, to
|
|
350
|
|
- -- avoid issues with command line size limit on
|
|
351
|
|
- -- Windows (#26637)
|
|
|
348
|
+ Ghc FindHsDependencies _ ->
|
|
|
349
|
+ -- We can't put the flags in a response file, because some flags
|
|
|
350
|
+ -- require empty arguments (such as the -dep-suffix flag), but
|
|
|
351
|
+ -- that isn't supported yet due to #26560.
|
|
352
|
352
|
runGhcWithResponse path buildArgs buildInputs
|
|
353
|
353
|
|
|
|
354
|
+ Ghc LinkHs _ ->
|
|
|
355
|
+ -- We do not pass `buildInputs` as they are duplicated in `buildArgs`
|
|
|
356
|
+ runGhcWithResponse path [] buildArgs
|
|
|
357
|
+
|
|
354
|
358
|
HsCpp -> captureStdout
|
|
355
|
359
|
|
|
356
|
360
|
Make dir -> cmd' buildOptions path ["-C", dir] buildArgs
|
| ... |
... |
@@ -393,15 +397,31 @@ runHaddock haddockPath flagArgs fileInputs = withTempFile $ \tmp -> do |
|
393
|
397
|
writeFile' tmp $ escapeArgs fileInputs
|
|
394
|
398
|
cmd [haddockPath] flagArgs ('@' : tmp)
|
|
395
|
399
|
|
|
396
|
|
-runGhcWithResponse :: FilePath -> [String] -> [FilePath] -> Action ()
|
|
397
|
|
-runGhcWithResponse ghcPath flagArgs fileInputs = withTempFile $ \tmp -> do
|
|
398
|
|
-
|
|
399
|
|
- writeFile' tmp $ escapeArgs fileInputs
|
|
400
|
|
-
|
|
401
|
|
- -- We can't put the flags in a response file, because some flags
|
|
402
|
|
- -- require empty arguments (such as the -dep-suffix flag), but
|
|
403
|
|
- -- that isn't supported yet due to #26560.
|
|
404
|
|
- cmd [ghcPath] flagArgs ('@' : tmp)
|
|
|
400
|
+-- | Use a response file for ghc invocations to avoid issues with command line
|
|
|
401
|
+-- size limit on Windows (#26637).
|
|
|
402
|
+runGhcWithResponse :: FilePath -- ^ Path to ghc
|
|
|
403
|
+ -> [String] -- ^ Arguments passed on the command line
|
|
|
404
|
+ -> [String] -- ^ Arguments passed via the response file (cannot contain empty arguemnts)
|
|
|
405
|
+ -> Action ()
|
|
|
406
|
+runGhcWithResponse ghcPath args responseFileArgs = withTempFile $ \tmp -> do
|
|
|
407
|
+ -- Extract RTS options from reponseFileArgs. Returns (ghc args, rts args)
|
|
|
408
|
+ let splitRtsArgs inRtsSection argsRest = case argsRest of
|
|
|
409
|
+ [] -> ([], [])
|
|
|
410
|
+ "--RTS":rest -> (rest, [])
|
|
|
411
|
+ "-RTS":rest -> splitRtsArgs False rest
|
|
|
412
|
+ "+RTS":rest -> splitRtsArgs True rest
|
|
|
413
|
+ arg:rest -> let (restGhc, restRts) = splitRtsArgs inRtsSection rest
|
|
|
414
|
+ in if inRtsSection
|
|
|
415
|
+ then (restGhc, arg:restRts)
|
|
|
416
|
+ else (arg:restGhc, restRts)
|
|
|
417
|
+ (responseFileArgsGhc, argsRts) = splitRtsArgs False responseFileArgs
|
|
|
418
|
+ tmpContents = escapeArgs responseFileArgsGhc
|
|
|
419
|
+ when
|
|
|
420
|
+ (any null responseFileArgsGhc)
|
|
|
421
|
+ (putWarn $ "Response file arguments (" <> tmp <> ") contains empty arguments")
|
|
|
422
|
+ putVerbose $ tmp <> ": " <> tmpContents
|
|
|
423
|
+ writeFile' tmp tmpContents
|
|
|
424
|
+ cmd [ghcPath] ("+RTS" : argsRts ++ ["-RTS"] ++ args) ('@' : tmp)
|
|
405
|
425
|
|
|
406
|
426
|
|
|
407
|
427
|
-- TODO: Some builders are required only on certain platforms. For example,
|