mingw32 negative processID and nonexistent SYSTEMROOT
This commit is contained in:
parent
00a5a94c60
commit
14654ff8f3
@ -243,7 +243,9 @@ mkdir0700 dir = createDirectory dir
|
|||||||
--
|
--
|
||||||
#ifdef __MINGW32__
|
#ifdef __MINGW32__
|
||||||
-- relies on Int == Int32 on Windows
|
-- relies on Int == Int32 on Windows
|
||||||
foreign import ccall unsafe "_getpid" getProcessID :: IO Int
|
foreign import ccall unsafe "_getpid" getProcessID' :: IO Int
|
||||||
|
getProcessID :: IO Int
|
||||||
|
getProcessID = liftM abs getProcessID'
|
||||||
#else
|
#else
|
||||||
getProcessID :: IO Int
|
getProcessID :: IO Int
|
||||||
#ifdef CYGWIN
|
#ifdef CYGWIN
|
||||||
|
@ -65,8 +65,7 @@ import System.IO.Unsafe ( unsafePerformIO )
|
|||||||
import System.Directory ( doesFileExist )
|
import System.Directory ( doesFileExist )
|
||||||
#if defined(CYGWIN) || defined(__MINGW32__)
|
#if defined(CYGWIN) || defined(__MINGW32__)
|
||||||
import System.Environment ( getEnv )
|
import System.Environment ( getEnv )
|
||||||
|
import System.IO.Error ( catch, ioError, isDoesNotExistError )
|
||||||
import Control.Monad ( liftM )
|
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
import Control.Concurrent.MVar ( MVar(), newMVar, withMVar )
|
import Control.Concurrent.MVar ( MVar(), newMVar, withMVar )
|
||||||
@ -383,7 +382,9 @@ lookupPkg' p = withPkgEnvs env $ \fms -> go fms p
|
|||||||
#endif
|
#endif
|
||||||
libs <- mapM (findHSlib libdirs) (hslibs ++ cbits)
|
libs <- mapM (findHSlib libdirs) (hslibs ++ cbits)
|
||||||
#if defined(CYGWIN) || defined(__MINGW32__)
|
#if defined(CYGWIN) || defined(__MINGW32__)
|
||||||
syslibdir <- liftM ( \x -> x ++ "/SYSTEM") (getEnv "SYSTEMROOT")
|
sysroot <- catch (getEnv "SYSTEMROOT")
|
||||||
|
(\e -> if isDoesNotExistError e then return "C:/windows" else ioError e) -- guess at a reasonable default
|
||||||
|
let syslibdir = sysroot ++ "/SYSTEM"
|
||||||
libs' <- mapM (findDLL $ syslibdir : libdirs) dlls
|
libs' <- mapM (findDLL $ syslibdir : libdirs) dlls
|
||||||
#else
|
#else
|
||||||
libs' <- mapM (findDLL libdirs) dlls
|
libs' <- mapM (findDLL libdirs) dlls
|
||||||
|
Loading…
x
Reference in New Issue
Block a user