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

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

@ -399,37 +399,37 @@
(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)))]
[bindir (if alt-exe
(let ([m (assq 'exe-is-gracket aux)])
(if (and m (cdr m))
(find-lib-dir)
(let ([p (path-only dest)])
(if (eq? 'macosx (cross-system-type))
(let* ([cdir (or (and addon?
(find-addon-tethered-console-bin-dir))
(and config?
(find-config-tethered-console-bin-dir))
(find-console-bin-dir))]
[gdir (or (and addon?
(find-addon-tethered-gui-bin-dir))
(and config?
(find-config-tethered-gui-bin-dir))
(find-gui-bin-dir))]
[rel (find-relative-path cdir gdir)])
(cond
[(relative-path? rel)
(build-path p rel)]
[(equal? cdir gdir) p]
[else rel]))
p))))
(if (eq? kind 'mred)
(find-gui-bin-dir)
(find-console-bin-dir)))]
[dir-finder [dir-finder
(let ([bindir (if alt-exe (if (let ([a (assq 'relative? aux)])
(let ([m (assq 'exe-is-gracket aux)]) (and a (cdr a)))
(if (and m (cdr m)) (make-relative-path-header dest bindir use-librktdir?)
(find-lib-dir) (make-absolute-path-header bindir))]
(let ([p (path-only dest)])
(if (eq? 'macosx (cross-system-type))
(let* ([cdir (or (and addon?
(find-addon-tethered-console-bin-dir))
(and config?
(find-config-tethered-console-bin-dir))
(find-console-bin-dir))]
[gdir (or (and addon?
(find-addon-tethered-gui-bin-dir))
(and config?
(find-config-tethered-gui-bin-dir))
(find-gui-bin-dir))]
[rel (find-relative-path cdir gdir)])
(cond
[(relative-path? rel)
(build-path p rel)]
[(equal? cdir gdir) p]
[else rel]))
p))))
(if (eq? kind 'mred)
(find-gui-bin-dir)
(find-console-bin-dir)))])
(if (let ([a (assq 'relative? aux)])
(and a (cdr a)))
(make-relative-path-header dest bindir use-librktdir?)
(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")