[commit: ghc] master: Fix gcc.exe: error: CreateProcess: No such file or directory (227ede4)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/227ede4aa0b6df1a2b5a95dbba9f3cabc88bc15e/ghc

>---------------------------------------------------------------

commit 227ede4aa0b6df1a2b5a95dbba9f3cabc88bc15e
Author: Moritz Angermann <moritz.angermann at gmail.com>
Date:   Tue Jun 19 23:27:53 2018 -0400

    Fix gcc.exe: error: CreateProcess: No such file or directory
    
    When GHC links binaries on windows, we pass a -L and -l flag
    to gcc for each dependency in the transitive dependency
    closure.  As this will usually overflow the command argument
    limit on windows, we use response files to pass all arguments
    to gcc.  gcc however internally passes only the -l flags via
    a response file to the collect2 command, but puts the -L flags
    on the command line. As such if we pass enough -L flags to
    gcc--even via a response file--we will eventually overflow the
    command line argument length limit due to gcc passing them
    to collect2 without resorting to a response file.
    
    To prevent this from happening we move all lirbaries into a
    shared temporary folder, and only need to pass a single -L
    flag to gcc.  Ideally however this was fixed in gcc.
    
    Reviewers: bgamari, Phyx
    
    Reviewed By: bgamari
    
    Subscribers: erikd, rwbarton, thomie, carter
    
    Differential Revision: https://phabricator.haskell.org/D4762


>---------------------------------------------------------------

227ede4aa0b6df1a2b5a95dbba9f3cabc88bc15e
 compiler/main/DriverPipeline.hs | 10 ++++++++++
 compiler/main/DynFlags.hs       |  9 +++++++++
 compiler/main/FileCleanup.hs    | 17 ++++++++++++++++-
 compiler/main/Packages.hs       | 10 +++++++++-
 4 files changed, 44 insertions(+), 2 deletions(-)

diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs
index e4a9fa2..92e3455 100644
--- a/compiler/main/DriverPipeline.hs
+++ b/compiler/main/DriverPipeline.hs
@@ -1744,6 +1744,16 @@ linkBinary' staticLink dflags o_files dep_packages = do
               in ["-L" ++ l] ++ ["-Xlinker", "-rpath", "-Xlinker", libpath]
          | otherwise = ["-L" ++ l]
 
+    pkg_lib_path_opts <-
+      if gopt Opt_SingleLibFolder dflags
+      then do
+        libs <- getLibs dflags dep_packages
+        tmpDir <- newTempDir dflags
+        sequence_ [ copyFile lib (tmpDir </> basename)
+                  | (lib, basename) <- libs]
+        return [ "-L" ++ tmpDir ]
+      else pure pkg_lib_path_opts
+
     let
       dead_strip
         | gopt Opt_WholeArchiveHsLibs dflags = []
diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index 77a6185..b10740b 100644
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -557,6 +557,13 @@ data GeneralFlag
    | Opt_OptimalApplicativeDo
    | Opt_VersionMacros
    | Opt_WholeArchiveHsLibs
+   -- copy all libs into a single folder prior to linking binaries
+   -- this should elivate the excessive command line limit restrictions
+   -- on windows, by only requiring a single -L argument instead of
+   -- one for each dependency.  At the time of this writing, gcc
+   -- forwards all -L flags to the collect2 command without using a
+   -- response file and as such breaking apart.
+   | Opt_SingleLibFolder
 
    -- output style opts
    | Opt_ErrorSpans -- Include full span info in error messages,
@@ -2820,6 +2827,8 @@ dynamic_flags_deps = [
 #endif
   , make_ord_flag defGhcFlag "relative-dynlib-paths"
       (NoArg (setGeneralFlag Opt_RelativeDynlibPaths))
+  , make_ord_flag defGhcFlag "copy-libs-when-linking"
+      (NoArg (setGeneralFlag Opt_SingleLibFolder))
   , make_ord_flag defGhcFlag "pie"            (NoArg (setGeneralFlag Opt_PICExecutable))
   , make_ord_flag defGhcFlag "no-pie"         (NoArg (unSetGeneralFlag Opt_PICExecutable))
 
diff --git a/compiler/main/FileCleanup.hs b/compiler/main/FileCleanup.hs
index 5150b81..35bed61 100644
--- a/compiler/main/FileCleanup.hs
+++ b/compiler/main/FileCleanup.hs
@@ -3,7 +3,7 @@ module FileCleanup
   ( TempFileLifetime(..)
   , cleanTempDirs, cleanTempFiles, cleanCurrentModuleTempFiles
   , addFilesToClean, changeTempFilesLifetime
-  , newTempName, newTempLibName
+  , newTempName, newTempLibName, newTempDir
   , withSystemTempDirectory, withTempDirectory
   ) where
 
@@ -132,6 +132,21 @@ newTempName dflags lifetime extn
                         addFilesToClean dflags lifetime [filename]
                         return filename
 
+newTempDir :: DynFlags -> IO FilePath
+newTempDir dflags
+  = do d <- getTempDir dflags
+       findTempDir (d </> "ghc_")
+  where
+    findTempDir :: FilePath -> IO FilePath
+    findTempDir prefix
+      = do n <- newTempSuffix dflags
+           let filename = prefix ++ show n
+           b <- doesDirectoryExist filename
+           if b then findTempDir prefix
+                else do createDirectory filename
+                        -- see mkTempDir below; this is wrong: -> consIORef (dirsToClean dflags) filename
+                        return filename
+
 newTempLibName :: DynFlags -> TempFileLifetime -> Suffix
   -> IO (FilePath, FilePath, String)
 newTempLibName dflags lifetime extn
diff --git a/compiler/main/Packages.hs b/compiler/main/Packages.hs
index d9c198a..71354b1 100644
--- a/compiler/main/Packages.hs
+++ b/compiler/main/Packages.hs
@@ -50,7 +50,7 @@ module Packages (
 
         collectArchives,
         collectIncludeDirs, collectLibraryPaths, collectLinkOpts,
-        packageHsLibs,
+        packageHsLibs, getLibs,
 
         -- * Utils
         unwireUnitId,
@@ -1761,6 +1761,14 @@ collectArchives dflags pc =
   where searchPaths = nub . filter notNull . libraryDirsForWay dflags $ pc
         libs        = packageHsLibs dflags pc ++ extraLibraries pc
 
+getLibs :: DynFlags -> [PreloadUnitId] -> IO [(String,String)]
+getLibs dflags pkgs = do
+  ps <- getPreloadPackagesAnd dflags pkgs
+  fmap concat . forM ps $ \p -> do
+    let candidates = [ (l </> f, f) | l <- collectLibraryPaths dflags [p]
+                                    , f <- (\n -> "lib" ++ n ++ ".a") <$> packageHsLibs dflags p ]
+    filterM (doesFileExist . fst) candidates
+
 packageHsLibs :: DynFlags -> PackageConfig -> [String]
 packageHsLibs dflags p = map (mkDynName . addSuffix) (hsLibraries p)
   where