diff options
| author | Tamar Christina <tamar@zhox.com> | 2017-08-29 22:59:38 +0100 |
|---|---|---|
| committer | Tamar Christina <tamar@zhox.com> | 2017-08-29 22:59:38 +0100 |
| commit | 3c6b2fc3b5ca11a5410405664e4640767ef941dd (patch) | |
| tree | 0535048a7de1f2bf7d8d4aaa24ea723c927d8c5c | |
| parent | 895a7650a038131f3043f882c558c627abe9a61e (diff) | |
| download | haskell-3c6b2fc3b5ca11a5410405664e4640767ef941dd.tar.gz | |
Fix decomposition error on Windows
Summary:
Fix the path decomposition error that occurs when the Symlink resolver
fails. `Win32.try` throws an exception, so catch it and assume the path
isn't a symlink to use the old behavior.
Test Plan: ./validate
Reviewers: austin, bgamari
Reviewed By: bgamari
Subscribers: rwbarton, thomie
GHC Trac Issues: #14159
Differential Revision: https://phabricator.haskell.org/D3891
| -rw-r--r-- | compiler/main/SysTools.hs | 13 |
1 files changed, 11 insertions, 2 deletions
diff --git a/compiler/main/SysTools.hs b/compiler/main/SysTools.hs index 57d77a3a13..b48bbf4202 100644 --- a/compiler/main/SysTools.hs +++ b/compiler/main/SysTools.hs @@ -1340,9 +1340,18 @@ getFinalPath name = do (fILE_ATTRIBUTE_NORMAL .|. fILE_FLAG_BACKUP_SEMANTICS) Nothing let fnPtr = makeGetFinalPathNameByHandle $ castPtrToFunPtr addr - path <- Win32.try "GetFinalPathName" + -- First try to resolve the path to get the actual path + -- of any symlinks or other file system redirections that + -- may be in place. However this function can fail, and in + -- the event it does fail, we need to try using the + -- original path and see if we can decompose that. + -- If the call fails Win32.try will raise an exception + -- that needs to be caught. See #14159 + path <- (Win32.try "GetFinalPathName" (\buf len -> fnPtr handle buf len 0) 512 - `finally` closeHandle handle + `finally` closeHandle handle) + `catch` + (\(_ :: IOException) -> return name) return $ Just path type GetFinalPath = HANDLE -> LPTSTR -> DWORD -> DWORD -> IO DWORD |