Merge pull request #3300 from 23Skidoo/issue-3185

Pass short path names to configure scripts on Windows.

Cabal/Cabal.cabal

@@ -339,6 +339,7 @@ library
 
   other-modules:
     Distribution.Compat.CopyFile
+    Distribution.Compat.GetShortPathName
     Distribution.Compat.MonadFail
     Distribution.GetOpt
     Distribution.Lex
@@ -354,9 +355,6 @@ library
       Distribution.Compat.Binary.Generic
 
   default-language: Haskell98
-  -- starting with GHC 7.0, rely on {-# LANGUAGE CPP #-} instead
-  if !impl(ghc >= 7.0)
-    default-extensions: CPP
 
 -- Small, fast running tests.
 test-suite unit-tests

Cabal/Distribution/Compat/GetShortPathName.hs

+{-# 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

Cabal/Distribution/Simple.hs

@@ -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