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

54
collects/setup/dirs.rkt
View File

@ -152,35 +152,39 @@
;; 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)))])
(with-input-from-file exe (and
(lambda () exe
(let ([m (regexp-match (byte-regexp (with-input-from-file exe
(bytes-append (lambda ()
(bytes->utf-16-bytes #"dLl dIRECTORy:") (let ([m (regexp-match (byte-regexp
#"((?:..)*?)\0\0")) (bytes-append
(current-input-port))]) (bytes->utf-16-bytes #"dLl dIRECTORy:")
(unless m #"((?:..)*?)\0\0"))
(error "cannot find \"dLl dIRECTORy\" tag in binary")) (current-input-port))])
(let-values ([(dir name dir?) (split-path exe)]) (unless m
(if (regexp-match #rx#"^<" (cadr m)) (error "cannot find \"dLl dIRECTORy\" tag in binary"))
;; no DLL dir in binary (let-values ([(dir name dir?) (split-path exe)])
#f (if (regexp-match #rx#"^<" (cadr m))
;; resolve relative directory: ;; no DLL dir in binary
(let ([p (bytes->path (utf-16-bytes->bytes (cadr m)))]) #f
(path->complete-path p dir))))))))] ;; resolve relative directory:
(let ([p (bytes->path (utf-16-bytes->bytes (cadr m)))])
(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))])
(if (link-exists? p) (and
(loop (let-values ([(r) (resolve-path p)] p
[(dir name dir?) (split-path p)]) (if (link-exists? p)
(if (and (path? dir) (loop (let-values ([(r) (resolve-path p)]
(relative-path? r)) [(dir name dir?) (split-path p)])
(build-path dir r) (if (and (path? dir)
r))) (relative-path? r))
p)))] (build-path dir r)
[rel (get/set-dylib-path exe "Racket" #f)]) r)))
p))))]
[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