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

Use correct base path for finding gracket. (#1609)

Browse Source 
Fixes error in http://drdr.racket-lang.org/38697/pkgs/compiler-test/tests/compiler/embed/test.rkt#output1
This commit is contained in:
Sam Tobin-Hochstadt 2017-02-03 15:19:28 +00:00 committed by GitHub
parent 8a49a8e545
commit 71a43f34c8
1 changed files with 31 additions and 33 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
racket/collects/launcher/launcher.rkt
View File

@ -399,8 +399,7 @@
(and im (eq? (cdr im) 'addon-tethered)))] (and im (eq? (cdr im) 'addon-tethered)))]
[config? (let ([im (assoc 'install-mode aux)]) [config? (let ([im (assoc 'install-mode aux)])
(and im (eq? (cdr im) 'config-tethered)))] (and im (eq? (cdr im) 'config-tethered)))]
[dir-finder [bindir (if alt-exe
(let ([bindir (if alt-exe
(let ([m (assq 'exe-is-gracket aux)]) (let ([m (assq 'exe-is-gracket aux)])
(if (and m (cdr m)) (if (and m (cdr m))
(find-lib-dir) (find-lib-dir)
@ -425,11 +424,12 @@
p)))) p))))
(if (eq? kind 'mred) (if (eq? kind 'mred)
(find-gui-bin-dir) (find-gui-bin-dir)
(find-console-bin-dir)))]) (find-console-bin-dir)))]
[dir-finder
(if (let ([a (assq 'relative? aux)]) (if (let ([a (assq 'relative? aux)])
(and a (cdr a))) (and a (cdr a)))
(make-relative-path-header dest bindir use-librktdir?) (make-relative-path-header dest bindir use-librktdir?)
(make-absolute-path-header bindir)))] (make-absolute-path-header bindir))]
[exec (format [exec (format
"exec \"${~a}/~a~a\" ~a" "exec \"${~a}/~a~a\" ~a"
(if use-librktdir? (if use-librktdir?
@ -470,9 +470,7 @@
(when use-librktdir? (when use-librktdir?
(display "# {{{ librktdir\n") (display "# {{{ librktdir\n")
(display "librktdir=\"$bindir/") (display "librktdir=\"$bindir/")
(display (find-relative-path (simplify-path (display (find-relative-path bindir
(let-values ([(base name dir?) (split-path (path->complete-path dest))])
base))
(simplify-path (simplify-path
(find-lib-dir)))) (find-lib-dir))))
(display "\"\n") (display "\"\n")