suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

do not normalize 'exec-file paths, because the existence of a path changes how the PATH envvar is used

Browse Source 
svn: r13395
This commit is contained in:
Matthew Flatt 2009-02-03 21:25:38 +00:00
parent 304b163623
commit f27f1f7223
1 changed files with 7 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
collects/setup/dirs.ss
View File

@ -10,7 +10,9 @@
;; path normalization is not really necessary by any existing code, ;; path normalization is not really necessary by any existing code,
;; but there might be applications that rely on these paths, so it's ;; but there might be applications that rely on these paths, so it's
;; best to do some minor normalization. This is similar to what ;; best to do some minor normalization. This is similar to what
;; "main-collects.ss" does. ;; "main-collects.ss" does. Don't use this with 'exec-file, however,
;; because the treatment of an executable path can very depending
;; on whether it has a path prefix or not.
(define (system-path* what) (define (system-path* what)
(simplify-path (cleanse-path (find-system-path what)) #f)) (simplify-path (cleanse-path (find-system-path what)) #f))
@ -26,14 +28,14 @@
;; This happens only under Windows; add a drive ;; This happens only under Windows; add a drive
;; specification to make the path complete ;; specification to make the path complete
(let ([exec (path->complete-path (let ([exec (path->complete-path
(find-executable-path (system-path* 'exec-file)) (find-executable-path (find-system-path 'exec-file))
(system-path* 'orig-dir))]) (system-path* 'orig-dir))])
(let-values ([(base name dir?) (split-path exec)]) (let-values ([(base name dir?) (split-path exec)])
(path->complete-path d base)))] (path->complete-path d base)))]
[else [else
;; Relative to executable... ;; Relative to executable...
(parameterize ([current-directory (system-path* 'orig-dir)]) (parameterize ([current-directory (system-path* 'orig-dir)])
(let ([p (or (find-executable-path (system-path* 'exec-file) d #t) (let ([p (or (find-executable-path (find-system-path 'exec-file) d #t)
;; If we get here, then we can't find the directory ;; If we get here, then we can't find the directory
#f)]) #f)])
(and p (simplify-path p))))])))) (and p (simplify-path p))))]))))
@ -175,7 +177,7 @@
[(windows) [(windows)
;; Extract "lib" location from binary: ;; Extract "lib" location from binary:
(let ([exe (parameterize ([current-directory (system-path* 'orig-dir)]) (let ([exe (parameterize ([current-directory (system-path* 'orig-dir)])
(find-executable-path (system-path* 'exec-file)))]) (find-executable-path (find-system-path 'exec-file)))])
(with-input-from-file exe (with-input-from-file exe
(lambda () (lambda ()
(let ([m (regexp-match (byte-regexp (let ([m (regexp-match (byte-regexp
@ -195,7 +197,7 @@
[(macosx) [(macosx)
(let* ([exe (parameterize ([current-directory (system-path* 'orig-dir)]) (let* ([exe (parameterize ([current-directory (system-path* 'orig-dir)])
(let loop ([p (find-executable-path (let loop ([p (find-executable-path
(system-path* 'exec-file))]) (find-system-path 'exec-file))])
(if (link-exists? p) (if (link-exists? p)
(loop (let-values ([(r) (resolve-path p)] (loop (let-values ([(r) (resolve-path p)]
[(dir name dir?) (split-path p)]) [(dir name dir?) (split-path p)])