diff options
Diffstat (limited to 'libraries')
-rw-r--r-- | libraries/base/GHC/Event/Windows.hsc | 5 | ||||
-rw-r--r-- | libraries/base/GHC/IO/Windows/Paths.hs | 2 | ||||
-rw-r--r-- | libraries/base/System/IO.hs | 24 | ||||
-rw-r--r-- | libraries/base/cbits/Win32Utils.c | 4 |
4 files changed, 19 insertions, 16 deletions
diff --git a/libraries/base/GHC/Event/Windows.hsc b/libraries/base/GHC/Event/Windows.hsc index b97250e897..cc6bbaa927 100644 --- a/libraries/base/GHC/Event/Windows.hsc +++ b/libraries/base/GHC/Event/Windows.hsc @@ -1162,7 +1162,7 @@ io_mngr_loop _event mgr = go False exit <- case event_id of _ | event_id == io_MANAGER_WAKEUP -> return False - _ | event_id == io_MANAGER_DIE -> return True + _ | event_id == io_MANAGER_DIE -> c_ioManagerFinished >> return True 0 -> return False -- spurious wakeup _ -> do debugIO $ "handling console event: " ++ show (event_id `shiftR` 1) start_console_handler (event_id `shiftR` 1) @@ -1203,6 +1203,9 @@ foreign import ccall unsafe "getIOManagerEvent" -- in the RTS (ThrIOManager.c) foreign import ccall unsafe "readIOManagerEvent" -- in the RTS (ThrIOManager.c) c_readIOManagerEvent :: IO Word32 +foreign import ccall unsafe "ioManagerFinished" -- in the RTS (ThrIOManager.c) + c_ioManagerFinished :: IO () + foreign import ccall unsafe "rtsSupportsBoundThreads" threadedIOMgr :: Bool -- | Sleep for n ms diff --git a/libraries/base/GHC/IO/Windows/Paths.hs b/libraries/base/GHC/IO/Windows/Paths.hs index 851dc37508..c755996f22 100644 --- a/libraries/base/GHC/IO/Windows/Paths.hs +++ b/libraries/base/GHC/IO/Windows/Paths.hs @@ -30,7 +30,7 @@ import GHC.IO import Foreign.C.String import Foreign.Marshal.Alloc (free) -foreign import WINDOWS_CCONV safe "__hs_create_device_name" +foreign import ccall safe "__hs_create_device_name" c_GetDevicePath :: CWString -> IO CWString -- | This function converts Windows paths between namespaces. More specifically diff --git a/libraries/base/System/IO.hs b/libraries/base/System/IO.hs index 265507d970..f831df6cb4 100644 --- a/libraries/base/System/IO.hs +++ b/libraries/base/System/IO.hs @@ -231,13 +231,13 @@ import Foreign.C.Error import Foreign.C.String import Foreign.Ptr import Foreign.Marshal.Alloc +import Foreign.Marshal.Utils (with) import Foreign.Storable import GHC.IO.SubSystem import GHC.IO.Windows.Handle (openFileAsTemp) import GHC.IO.Handle.Windows (mkHandleFromHANDLE) import GHC.IO.Device as IODevice import GHC.Real (fromIntegral) -import Foreign.Marshal.Utils (new) #endif import Foreign.C.Types import System.Posix.Internals @@ -529,17 +529,17 @@ openTempFile' loc tmp_dir template binary mode let label = if null prefix then "ghc" else prefix withCWString tmp_dir $ \c_tmp_dir -> withCWString label $ \c_template -> - withCWString suffix $ \c_suffix -> do - c_ptr <- new nullPtr - res <- c_createUUIDTempFileErrNo c_tmp_dir c_template c_suffix - c_ptr - if not res - then do errno <- getErrno - ioError (errnoToIOError loc errno Nothing (Just tmp_dir)) - else do c_p <- peek c_ptr - filename <- peekCWString c_p - free c_p - handleResultsWinIO filename ((fromIntegral mode .&. o_EXCL) == o_EXCL) + withCWString suffix $ \c_suffix -> + with nullPtr $ \c_ptr -> do + res <- c_createUUIDTempFileErrNo c_tmp_dir c_template c_suffix c_ptr + if not res + then do errno <- getErrno + ioError (errnoToIOError loc errno Nothing (Just tmp_dir)) + else do c_p <- peek c_ptr + filename <- peekCWString c_p + free c_p + let flags = fromIntegral mode .&. o_EXCL + handleResultsWinIO filename (flags == o_EXCL) findTempNamePosix = do let label = if null prefix then "ghc" else prefix diff --git a/libraries/base/cbits/Win32Utils.c b/libraries/base/cbits/Win32Utils.c index f3dec0d98d..69d30339ba 100644 --- a/libraries/base/cbits/Win32Utils.c +++ b/libraries/base/cbits/Win32Utils.c @@ -183,10 +183,9 @@ bool __createUUIDTempFileErrNo (wchar_t* pathName, wchar_t* prefix, RPC_WSTR guidStr; if (UuidToStringW ((UUID*)&guid, &guidStr) != S_OK) goto fail; - /* We can't create a device path here since this path escapes the compiler so instead return a normal path and have openFile deal with it. */ - wchar_t* devName = malloc (sizeof (wchar_t) * wcslen (pathName)); + wchar_t* devName = malloc (sizeof (wchar_t) * (wcslen (pathName) + 1)); wcscpy (devName, pathName); int len = wcslen (devName) + wcslen (suffix) + wcslen (prefix) + wcslen (guidStr) + 3; @@ -204,6 +203,7 @@ bool __createUUIDTempFileErrNo (wchar_t* pathName, wchar_t* prefix, free (devName); RpcStringFreeW (&guidStr); + /* This should never happen because GUIDs are unique. But in case hell froze over let's check anyway. */ DWORD dwAttrib = GetFileAttributesW (*tempFileName); |