get-lib-search-dirs: repair for cross-compile mode

More generally, repair the internal `exe-relative-path->complete-path`
function to work when the current directory is not the original
current directory and `racket` is started with a relative path.
Currently, it happens that `exe-relative-path->complete-path` is
called with a potentially different directory only by
`get-lib-search-dirs`.
This commit is contained in:
Matthew Flatt 2019-05-23 17:30:09 -06:00
parent c63c5168be
commit 3d3f1a408c

View File

@ -33,11 +33,24 @@
[(absolute-path? collects-path)
;; This happens only under Windows; add a drive
;; specification to make the path complete
(let ([exec (path->complete-path
(find-executable-path (find-system-path 'exec-file))
(find-system-path 'orig-dir))])
(let ([exec (call-in-original-directory
(lambda ()
(path->complete-path
(find-executable-path (find-system-path 'exec-file))
(find-system-path 'orig-dir))))])
(let-values ([(base name dir?) (split-path exec)])
(simplify-path (path->complete-path collects-path base))))]
[else
(let ([p (find-executable-path (find-system-path 'exec-file) collects-path #t)])
(and p (simplify-path p)))]))))
(let ([p (call-in-original-directory
(lambda ()
(find-executable-path (find-system-path 'exec-file) collects-path #t)))])
(and p (simplify-path p)))])))
(define-values (call-in-original-directory)
(lambda (thunk)
(with-continuation-mark
parameterization-key
(extend-parameterization (continuation-mark-set-first #f parameterization-key)
current-directory
(find-system-path 'orig-dir))
(thunk)))))