projects
/
ghc-hetmet.git
/ commitdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
| commitdiff |
tree
raw
|
patch
|
inline
| side by side (parent:
ef993c5
)
Perform case-insensitive matching of path components in getBaseDir on Windows (Fixes...
author
Neil Mitchell
<ndmitchell@gmail.com>
Wed, 5 Nov 2008 13:43:15 +0000
(13:43 +0000)
committer
Neil Mitchell
<ndmitchell@gmail.com>
Wed, 5 Nov 2008 13:43:15 +0000
(13:43 +0000)
compiler/main/SysTools.lhs
patch
|
blob
|
history
diff --git
a/compiler/main/SysTools.lhs
b/compiler/main/SysTools.lhs
index
828530b
..
d1fd9f7
100644
(file)
--- a/
compiler/main/SysTools.lhs
+++ b/
compiler/main/SysTools.lhs
@@
-844,16
+844,17
@@
getBaseDir = do let len = (2048::Int) -- plenty, PATH_MAX is 512 under Win32.
return (Just (rootDir s))
where
rootDir s = case splitFileName $ normalise s of
return (Just (rootDir s))
where
rootDir s = case splitFileName $ normalise s of
- (d, ghc_exe) | map toLower ghc_exe == "ghc.exe" ->
+ (d, ghc_exe) | lower ghc_exe == "ghc.exe" ->
case splitFileName $ takeDirectory d of
-- installed ghc.exe is in $topdir/bin/ghc.exe
case splitFileName $ takeDirectory d of
-- installed ghc.exe is in $topdir/bin/ghc.exe
- (d', "bin") -> takeDirectory d'
+ (d', bin) | lower bin == "bin" -> takeDirectory d'
-- inplace ghc.exe is in $topdir/ghc/stage1-inplace/ghc.exe
-- inplace ghc.exe is in $topdir/ghc/stage1-inplace/ghc.exe
- (d', x) | "-inplace" `isSuffixOf` x ->
+ (d', x) | "-inplace" `isSuffixOf` lower x ->
takeDirectory d' </> ".."
_ -> fail
_ -> fail
where fail = panic ("can't decompose ghc.exe path: " ++ show s)
takeDirectory d' </> ".."
_ -> fail
_ -> fail
where fail = panic ("can't decompose ghc.exe path: " ++ show s)
+ lower = map toLower
foreign import stdcall unsafe "GetModuleFileNameA"
getModuleFileName :: Ptr () -> CString -> Int -> IO Int32
foreign import stdcall unsafe "GetModuleFileNameA"
getModuleFileName :: Ptr () -> CString -> Int -> IO Int32