Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Glasgow Haskell Compiler
Packages
Cabal
Commits
7ddeb76f
Commit
7ddeb76f
authored
Apr 08, 2016
by
Mikhail Glushenkov
Browse files
Merge pull request #3300 from 23Skidoo/issue-3185
Pass short path names to configure scripts on Windows.
parents
05936d9d
b946c05e
Changes
3
Hide whitespace changes
Inline
Side-by-side
Cabal/Cabal.cabal
View file @
7ddeb76f
...
...
@@ -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
0 → 100644
View file @
7ddeb76f
{-# 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
View file @
7ddeb76f
...
...
@@ -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="
++
ccProg
Short
]
shProg
=
simpleProgram
"sh"
progDb
=
modifyProgramSearchPath
(
\
p
->
map
ProgramSearchPathDir
extraPath
++
p
)
emptyProgramDb
shConfiguredProg
<-
lookupProgram
shProg
`
fmap
`
configureProgram
verbosity
shProg
progDb
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment