Commit b946c05e authored by Mikhail Glushenkov's avatar Mikhail Glushenkov
Browse files

Pass short path names to configure scripts on Windows.

Fixes #3185.
parent 574086ce
......@@ -339,6 +339,7 @@ library
other-modules:
Distribution.Compat.CopyFile
Distribution.Compat.GetShortPathName
Distribution.Compat.MonadFail
Distribution.GetOpt
Distribution.Lex
......
{-# LANGUAGE CPP, ForeignFunctionInterface #-}
-----------------------------------------------------------------------------
-- |
-- Module : Distribution.Compat.GetShortPathName
--
-- Maintainer : cabal-devel@haskell.org
-- Portability : Windows-only
--
-- Win32 API 'GetShortPathName' function.
module Distribution.Compat.GetShortPathName ( getShortPathName )
where
#ifdef mingw32_HOST_OS
import Control.Monad (void)
import qualified System.Win32 as Win32
import System.Win32 (LPCTSTR, LPTSTR, DWORD)
import Foreign.Marshal.Array (allocaArray)
#ifdef x86_64_HOST_ARCH
#define WINAPI ccall
#else
#define WINAPI stdcall
#endif
foreign import WINAPI unsafe "windows.h GetShortPathNameW"
c_GetShortPathName :: LPCTSTR -> LPTSTR -> DWORD -> IO DWORD
-- | On Windows, retrieves the short path form of the specified path. On
-- non-Windows, does nothing. See https://github.com/haskell/cabal/issues/3185.
getShortPathName :: FilePath -> IO FilePath
getShortPathName path =
Win32.withTString path $ \c_path ->
allocaArray arr_len $ \c_out -> do
void $ Win32.failIfZero "GetShortPathName failed!" $
c_GetShortPathName c_path c_out c_len
Win32.peekTString c_out
where
arr_len = length path + 1
c_len = fromIntegral arr_len
#else
getShortPathName :: FilePath -> IO FilePath
getShortPathName path = return path
#endif
......@@ -87,12 +87,13 @@ import Distribution.License
import Distribution.Text
-- Base
import System.Environment(getArgs, getProgName)
import System.Directory(removeFile, doesFileExist,
doesDirectoryExist, removeDirectoryRecursive)
import System.Exit (exitWith,ExitCode(..))
import System.FilePath(searchPathSeparator)
import Distribution.Compat.Environment (getEnvironment)
import System.Environment (getArgs, getProgName)
import System.Directory (removeFile, doesFileExist
,doesDirectoryExist, removeDirectoryRecursive)
import System.Exit (exitWith,ExitCode(..))
import System.FilePath (searchPathSeparator)
import Distribution.Compat.Environment (getEnvironment)
import Distribution.Compat.GetShortPathName (getShortPathName)
import Control.Monad (when)
import Data.Foldable (traverse_)
......@@ -611,6 +612,7 @@ runConfigureScript verbosity backwardsCompatHack flags lbi = do
env <- getEnvironment
let programConfig = withPrograms lbi
(ccProg, ccFlags) <- configureCCompiler verbosity programConfig
ccProgShort <- getShortPathName ccProg
-- The C compiler's compilation and linker flags (e.g.
-- "C compiler flags" and "Gcc Linker flags" from GHC) have already
-- been merged into ccFlags, so we set both CFLAGS and LDFLAGS
......@@ -622,7 +624,7 @@ runConfigureScript verbosity backwardsCompatHack flags lbi = do
spSep = [searchPathSeparator]
pathEnv = maybe (intercalate spSep extraPath) ((intercalate spSep extraPath ++ spSep)++) $ lookup "PATH" env
overEnv = ("CFLAGS", Just cflagsEnv) : [("PATH", Just pathEnv) | not (null extraPath)]
args' = args ++ ["CC=" ++ ccProg]
args' = args ++ ["CC=" ++ ccProgShort]
shProg = simpleProgram "sh"
progDb = modifyProgramSearchPath (\p -> map ProgramSearchPathDir extraPath ++ p) emptyProgramDb
shConfiguredProg <- lookupProgram shProg `fmap` configureProgram verbosity shProg progDb
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment