Correct Windows libdir assumptions.
authorTamar Christina <tamar@zhox.com>
Thu, 23 Feb 2017 23:07:19 +0000 (18:07 -0500)
committerBen Gamari <ben@smart-cactus.org>
Thu, 23 Feb 2017 23:57:17 +0000 (18:57 -0500)
GHC and ghc-pkg make some pretty hard assumptions about where they're
running on Windows. They assume that they are always running from
`foo/bin/ghc.exe` and that to find the `lib` folder they can drop
`bin/ghc.exe` from the base path and append `lib`.

This is already false for the testsuite, which when testing thenbindist
 has one test which puts the binaries in `inplace/test   spaces`.

For some reason before this was either being skipped or mysteriously
passing.
But as of `2017.02.11` our luck ran out.

the testsuite triggers a failure such as those in #13310

Let's soften the assumption and just check that `../lib` exists instead.

80 chars

Test Plan: ./validate

Reviewers: austin, erikd, bgamari

Reviewed By: bgamari

Subscribers: thomie, #ghc_windows_task_force

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

compiler/main/SysTools.hs
utils/ghc-pkg/Main.hs

index b34b1b8..9a9f899 100644 (file)
@@ -91,13 +91,10 @@ import qualified System.Win32.Types as Win32
 #else
 import qualified System.Win32.Info as Win32
 #endif
-import Control.Exception (finally)
-import Foreign.Ptr (FunPtr, castPtrToFunPtr)
 import System.Win32.Types (DWORD, LPTSTR, HANDLE)
 import System.Win32.Types (failIfNull, failIf, iNVALID_HANDLE_VALUE)
 import System.Win32.File (createFile,closeHandle, gENERIC_READ, fILE_SHARE_READ, oPEN_EXISTING, fILE_ATTRIBUTE_NORMAL, fILE_FLAG_BACKUP_SEMANTICS )
 import System.Win32.DLL (loadLibrary, getProcAddress)
-import Data.Bits((.|.))
 #endif
 
 import System.Process
@@ -131,9 +128,9 @@ On Unix:
 On Windows:
   - ghc never has a shell wrapper.
   - we can find the location of the ghc binary, which is
-        $topdir/bin/<something>.exe
+        $topdir/<foo>/<something>.exe
     where <something> may be "ghc", "ghc-stage2", or similar
-  - we strip off the "bin/<something>.exe" to leave $topdir.
+  - we strip off the "<foo>/<something>.exe" to leave $topdir.
 
 from topdir we can find package.conf, ghc-asm, etc.
 
@@ -1463,7 +1460,7 @@ traceCmd dflags phase_name cmd_line action
 
 getBaseDir :: IO (Maybe String)
 #if defined(mingw32_HOST_OS)
--- Assuming we are running ghc, accessed by path  $(stuff)/bin/ghc.exe,
+-- Assuming we are running ghc, accessed by path  $(stuff)/<foo>/ghc.exe,
 -- return the path $(stuff)/lib.
 getBaseDir = try_size 2048 -- plenty, PATH_MAX is 512 under Win32.
   where
@@ -1471,9 +1468,14 @@ getBaseDir = try_size 2048 -- plenty, PATH_MAX is 512 under Win32.
         ret <- c_GetModuleFileName nullPtr buf size
         case ret of
           0 -> return Nothing
-          _ | ret < size -> do path <- peekCWString buf
-                               real <- getFinalPath path -- try to resolve symlinks paths
-                               return $ (Just . rootDir . sanitize . maybe path id) real
+          _ | ret < size -> do
+                path <- peekCWString buf
+                real <- getFinalPath path -- try to resolve symlinks paths
+                let libdir = (rootDir . sanitize . maybe path id) real
+                exists <- doesDirectoryExist libdir
+                if exists
+                   then return $ Just libdir
+                   else fail path
             | otherwise  -> try_size (size * 2)
 
     -- getFinalPath returns paths in full raw form.
@@ -1492,11 +1494,11 @@ getBaseDir = try_size 2048 -- plenty, PATH_MAX is 512 under Win32.
                                          "ghc-stage3.exe"] ->
                     case splitFileName $ takeDirectory d of
                     -- ghc is in $topdir/bin/ghc.exe
-                    (d', bin) | lower bin == "bin" -> takeDirectory d' </> "lib"
-                    _ -> fail
-                _ -> fail
-        where fail = panic ("can't decompose ghc.exe path: " ++ show s)
-              lower = map toLower
+                    (d', _) -> takeDirectory d' </> "lib"
+                _ -> fail s
+
+    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
index b350e08..3355838 100644 (file)
@@ -62,9 +62,7 @@ import qualified Data.ByteString.Char8 as BS
 -- mingw32 needs these for getExecDir
 import Foreign
 import Foreign.C
-#endif
-
-#ifdef mingw32_HOST_OS
+import System.Directory ( canonicalizePath )
 import GHC.ConsoleHandler
 #else
 import System.Posix hiding (fdToHandle)
@@ -1947,7 +1945,15 @@ unDosifyPath :: FilePath -> FilePath
 unDosifyPath xs = subst '\\' '/' xs
 
 getLibDir :: IO (Maybe String)
-getLibDir = fmap (fmap (</> "lib")) $ getExecDir "/bin/ghc-pkg.exe"
+getLibDir = do base   <- getExecDir "/ghc-pkg.exe"
+               case base of
+                 Nothing    -> return Nothing
+                 Just base' -> do
+                    libdir <- canonicalizePath $ base' </> "../lib"
+                    exists <- doesDirectoryExist libdir
+                    if exists
+                       then return $ Just libdir
+                       else return Nothing
 
 -- (getExecDir cmd) returns the directory in which the current
 --                  executable, which should be called 'cmd', is running