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