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

setup/dirs: fix for failure to find embedding executable

Browse Source
This commit is contained in:
Matthew Flatt 2012-09-21 07:18:55 -06:00
parent 99274b203a
commit c75c0d9946
1 changed files with 29 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
collects/setup/dirs.rkt
View File

@ -152,6 +152,8 @@
;; 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 (find-system-path 'exec-file)))]) (find-executable-path (find-system-path 'exec-file)))])
(and
exe
(with-input-from-file exe (with-input-from-file exe
(lambda () (lambda ()
(let ([m (regexp-match (byte-regexp (let ([m (regexp-match (byte-regexp
@ -167,11 +169,13 @@
#f #f
;; resolve relative directory: ;; resolve relative directory:
(let ([p (bytes->path (utf-16-bytes->bytes (cadr m)))]) (let ([p (bytes->path (utf-16-bytes->bytes (cadr m)))])
(path->complete-path p dir))))))))] (path->complete-path p dir)))))))))]
[(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
(find-system-path 'exec-file))]) (find-system-path 'exec-file))])
(and
p
(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)])
@ -179,8 +183,8 @@
(relative-path? r)) (relative-path? r))
(build-path dir r) (build-path dir r)
r))) r)))
p)))] p))))]
[rel (get/set-dylib-path exe "Racket" #f)]) [rel (and exe (get/set-dylib-path exe "Racket" #f))])
(cond (cond
[(not rel) #f] ; no framework reference found!? [(not rel) #f] ; no framework reference found!?
[(regexp-match [(regexp-match