Remove executable filename check on windows
authorklebinger.andreas@gmx.at <klebinger.andreas@gmx.at>
Mon, 15 Jan 2018 18:52:15 +0000 (13:52 -0500)
committerBen Gamari <ben@smart-cactus.org>
Thu, 18 Jan 2018 19:20:28 +0000 (14:20 -0500)
On Windows GHC enforces currently that the real executable is named
ghc.exe/ghc-stage[123].exe.

I don't see a good reason why this is neccessary.
This patch removes this restriction and fixes #14652

Test Plan: ci

Reviewers: bgamari, Phyx

Reviewed By: Phyx

Subscribers: Phyx, rwbarton, thomie, carter

GHC Trac Issues: #14652

Differential Revision: https://phabricator.haskell.org/D4296

(cherry picked from commit 1bf70b2041dc2b7c89565fcb46cad8f151f96790)

compiler/main/SysTools/BaseDir.hs

index 343be82..2c264b8 100644 (file)
@@ -34,7 +34,6 @@ import qualified System.Win32.Types as Win32
 #else
 import qualified System.Win32.Info as Win32
 #endif
-import Data.Char
 import Exception
 import Foreign
 import Foreign.C.String
@@ -111,7 +110,7 @@ getBaseDir = try_size 2048 -- plenty, PATH_MAX is 512 under Win32.
           _ | ret < size -> do
                 path <- peekCWString buf
                 real <- getFinalPath path -- try to resolve symlinks paths
-                let libdir = (rootDir . sanitize . maybe path id) real
+                let libdir = (buildLibDir . sanitize . maybe path id) real
                 exists <- doesDirectoryExist libdir
                 if exists
                    then return $ Just libdir
@@ -126,19 +125,11 @@ getBaseDir = try_size 2048 -- plenty, PATH_MAX is 512 under Win32.
                     then drop 4 s
                     else s
 
-    rootDir s = case splitFileName $ normalise s of
-                (d, ghc_exe)
-                 | lower ghc_exe `elem` ["ghc.exe",
-                                         "ghc-stage1.exe",
-                                         "ghc-stage2.exe",
-                                         "ghc-stage3.exe"] ->
-                    case splitFileName $ takeDirectory d of
-                    -- ghc is in $topdir/bin/ghc.exe
-                    (d', _) -> takeDirectory d' </> "lib"
-                _ -> fail s
+    buildLibDir :: FilePath -> FilePath
+    buildLibDir s =
+      (takeDirectory . takeDirectory . normalise $ s) </> "lib"
 
     fail s = panic ("can't decompose ghc.exe path: " ++ show s)
-    lower = map toLower
 
 foreign import WINDOWS_CCONV unsafe "windows.h GetModuleFileNameW"
   c_GetModuleFileName :: Ptr () -> CWString -> Word32 -> IO Word32