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

raco exe: add --config-path option, default to "etc"

Browse Source 
Make executables created by `raco exe` not refer to the original
configuration directory by default, but add an option for setting
the directory.

For Unix ELF executables, fix `raco exe` to set/preserve the
configuration directory.

Merge to v6.0
This commit is contained in:
Matthew Flatt 2013-11-29 10:18:10 -07:00
parent 35055c3b00
commit 33b7d49b2e
5 changed files with 120 additions and 79 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
pkgs/compiler-pkgs/compiler-lib/compiler/commands/exe.rkt
View File

@ -16,6 +16,7 @@
(define exe-embedded-flags (make-parameter '("-U" "--")))
(define exe-embedded-libraries (make-parameter null))
(define exe-aux (make-parameter null))
(define exe-embedded-config-path (make-parameter "etc"))
(define exe-embedded-collects-path (make-parameter null))
(define exe-embedded-collects-dest (make-parameter #f))
@ -29,6 +30,8 @@
(gui #t)]
[("-l" "--launcher") "Generate a launcher"
(launcher #t)]
[("--config-path") path "Set <path> as configuration directory for executable"
(exe-embedded-config-path path)]
[("--collects-path") path "Set <path> as main collects for executable"
(exe-embedded-collects-path path)]
[("--collects-dest") dir "Write collection code to <dir>"
@ -133,6 +136,7 @@
#:cmdline (exe-embedded-flags)
#:collects-path (exe-embedded-collects-path)
#:collects-dest (exe-embedded-collects-dest)
#:aux (exe-aux))])
#:aux (cons `(config-dir . ,(exe-embedded-config-path))
(exe-aux)))])
(when (verbose)
(printf " [output to \"~a\"]\n" dest)))

8
pkgs/compiler-pkgs/compiler-test/tests/compiler/embed/embed-me6b.rkt Normal file
View File

@ -0,0 +1,8 @@
(module embed-me6b racket/base
(with-output-to-file "stdout"
(lambda ()
(printf "This is 6\n")
(with-handlers ([void (lambda (exn) (printf "no etc.ss\n"))])
(printf "~a\n" (and (dynamic-require 'racket/fixnum #f) #t))))
#:exists 'append))

92
pkgs/compiler-pkgs/compiler-test/tests/compiler/embed/test.rkt
View File

@ -363,46 +363,64 @@
(path->string (build-path (collection-path "tests" "compiler" "embed") "embed-me1.rkt")))
(try-exe (mk-dest mred?) "This is 1\n" mred?)
;; Check that etc.rkt isn't found if it's not included:
(printf ">>not included\n")
(system* mzc
(if mred? "--gui-exe" "--exe")
(path->string (mk-dest mred?))
(path->string (build-path (collection-path "tests" "compiler" "embed") "embed-me6.rkt")))
(try-exe (mk-dest mred?) "This is 6\nno etc.ss\n" mred?)
(define (check-collection-path prog lib in-main?)
;; Check that etc.rkt isn't found if it's not included:
(printf ">>not included\n")
(system* mzc
(if mred? "--gui-exe" "--exe")
(path->string (mk-dest mred?))
(path->string (build-path (collection-path "tests" "compiler" "embed") prog)))
(try-exe (mk-dest mred?) "This is 6\nno etc.ss\n" mred?)
;; And it is found if it is included:
(printf ">>included\n")
(system* mzc
(if mred? "--gui-exe" "--exe")
(path->string (mk-dest mred?))
"++lib" "mzlib/etc.rkt"
(path->string (build-path (collection-path "tests" "compiler" "embed") "embed-me6.rkt")))
(try-exe (mk-dest mred?) "This is 6\n#t\n" mred?)
;; And it is found if it is included:
(printf ">>included\n")
(system* mzc
(if mred? "--gui-exe" "--exe")
(path->string (mk-dest mred?))
"++lib" lib
(path->string (build-path (collection-path "tests" "compiler" "embed") prog)))
(try-exe (mk-dest mred?) "This is 6\n#t\n" mred?)
;; Or, it's found if we set the collection path:
(printf ">>set coll path\n")
(system* mzc
(if mred? "--gui-exe" "--exe")
(path->string (mk-dest mred?))
"--collects-path"
(path->string (find-collects-dir))
(path->string (build-path (collection-path "tests" "compiler" "embed") "embed-me6.rkt")))
;; Don't try a distribution for this one:
(try-one-exe (mk-dest mred?) "This is 6\n#t\n" mred?)
;; Or, it's found if we set the collection path and the config path (where the latter
;; finds links for packages):
(printf ">>set coll path\n")
(system* mzc
(if mred? "--gui-exe" "--exe")
(path->string (mk-dest mred?))
"--collects-path"
(path->string (find-collects-dir))
(path->string (build-path (collection-path "tests" "compiler" "embed") prog)))
;; Don't try a distribution for this one:
(try-one-exe (mk-dest mred?) (if in-main? "This is 6\n#t\n" "This is 6\nno etc.ss\n") mred?)
;; Try --collects-dest mode
(printf ">>--collects-dest\n")
(system* mzc
(if mred? "--gui-exe" "--exe")
(path->string (mk-dest mred?))
"++lib" "mzlib/etc.rkt"
"--collects-dest" "cts"
"--collects-path" "cts"
(path->string (build-path (collection-path "tests" "compiler" "embed") "embed-me6.rkt")))
(try-exe (mk-dest mred?) "This is 6\n#t\n" mred? void "cts") ; <- cts copied to distribution
(delete-directory/files "cts")
(test #f system* (mk-dest mred?))
;; Or, it's found if we set the collection path and the config path (where the latter
;; finds links for packages):
(printf ">>set coll path plus config\n")
(system* mzc
(if mred? "--gui-exe" "--exe")
(path->string (mk-dest mred?))
"--collects-path"
(path->string (find-collects-dir))
"--config-path"
(path->string (find-config-dir))
(path->string (build-path (collection-path "tests" "compiler" "embed") prog)))
;; Don't try a distribution for this one:
(try-one-exe (mk-dest mred?) "This is 6\n#t\n" mred?)
;; Try --collects-dest mode
(printf ">>--collects-dest\n")
(system* mzc
(if mred? "--gui-exe" "--exe")
(path->string (mk-dest mred?))
"++lib" lib
"--collects-dest" "cts"
"--collects-path" "cts"
(path->string (build-path (collection-path "tests" "compiler" "embed") prog)))
(try-exe (mk-dest mred?) "This is 6\n#t\n" mred? void "cts") ; <- cts copied to distribution
(delete-directory/files "cts")
(test #f system* (mk-dest mred?)))
(check-collection-path "embed-me6b.rkt" "racket/fixnum.rkt" #t)
(check-collection-path "embed-me6.rkt" "mzlib/etc.rkt" #f)
(void)))

8
pkgs/mzscheme-pkgs/mzscheme-lib/compiler/main.rkt
View File

@ -56,6 +56,7 @@
(define exe-embedded-flags (make-parameter '("-U" "--")))
(define exe-embedded-libraries (make-parameter null))
(define exe-aux (make-parameter null))
(define exe-embedded-config-path (make-parameter "etc"))
(define exe-embedded-collects-path (make-parameter #f))
(define exe-embedded-collects-dest (make-parameter #f))
(define exe-dir-add-collects-dirs (make-parameter null))
@ -196,6 +197,10 @@
[help-labels
"--------------------- executable configuration flags ------------------------"]
[once-each
[("--config-path")
,(lambda (f i)
(exe-embedded-config-path i))
("Set <path> configuration directory path in --[gui-]exe" "path")]
[("--collects-path")
,(lambda (f i)
(exe-embedded-collects-path i))
@ -536,7 +541,8 @@
#:cmdline (exe-embedded-flags)
#:collects-path (exe-embedded-collects-path)
#:collects-dest (exe-embedded-collects-dest)
#:aux (exe-aux))
#:aux (cons `(config-dir . ,(exe-embedded-config-path))
(exe-aux)))
(when (compiler:option:somewhat-verbose)
(printf " [output to \"~a\"]\n" dest)))]
[(c-mods)

85
racket/collects/compiler/embed.rkt
View File

@ -1411,32 +1411,35 @@
(let-values ([(orig-dir name dir?) (split-path
(path->complete-path orig-exe))])
(update-dll-dir dest (build-path orig-dir dir))))))))
(let ([m (or (assq 'config-dir aux)
(and relative? '(config-dir . #f)))]
[dest->executable (lambda (dest)
(if osx?
(mac-dest->executable dest mred?)
dest))])
(if m
(if (cdr m)
(update-config-dir (dest->executable dest) (cdr m))
(when mred?
(cond
[osx?
;; adjust relative path (since GRacket is off by one):
(update-config-dir (mac-dest->executable dest mred?)
"../../../etc/")]
[(eq? 'windows (system-type))
(unless keep-exe?
(define (adjust-config-dir)
(let ([m (or (assq 'config-dir aux)
(and relative? '(config-dir . #f)))]
[dest->executable (lambda (dest)
(if osx?
(mac-dest->executable dest mred?)
dest))])
(if m
(if (cdr m)
(update-config-dir (dest->executable dest) (cdr m))
(when mred?
(cond
[osx?
;; adjust relative path (since GRacket is off by one):
(update-config-dir dest "etc/"))])))
;; Check whether we need an absolute path to config:
(let ([dir (get-current-config-dir (dest->executable dest))])
(when (relative-path? dir)
(let-values ([(orig-dir name dir?) (split-path
(path->complete-path orig-exe))])
(update-config-dir (dest->executable dest)
(build-path orig-dir dir)))))))
(update-config-dir (mac-dest->executable dest mred?)
"../../../etc/")]
[(eq? 'windows (system-type))
(unless keep-exe?
;; adjust relative path (since GRacket is off by one):
(update-config-dir dest "etc/"))])))
;; Check whether we need an absolute path to config:
(let ([dir (get-current-config-dir (dest->executable dest))])
(when (relative-path? dir)
(let-values ([(orig-dir name dir?) (split-path
(path->complete-path orig-exe))])
(update-config-dir (dest->executable dest)
(build-path orig-dir dir))))))))
(unless unix-starter? ; need to delay adjustment for Unix starter; see below
(adjust-config-dir))
(let ([write-module
(lambda (s)
(define pos #f)
@ -1525,24 +1528,24 @@
;; Unix starter: Maybe ELF, in which case we
;; can add a proper section
(let-values ([(s e dl p)
(if unix-starter?
(add-racket-section
orig-exe
dest-exe
(if launcher? #".rackcmdl" #".rackprog")
(lambda (start)
(let ([s (open-output-bytes)])
(define decl-len (write-module s))
(let ([p (file-position s)])
(display (make-starter-cmdline
(make-full-cmdline start
(if unix-starter?
(add-racket-section
orig-exe
dest-exe
(if launcher? #".rackcmdl" #".rackprog")
(lambda (start)
(let ([s (open-output-bytes)])
(define decl-len (write-module s))
(let ([p (file-position s)])
(display (make-starter-cmdline
(make-full-cmdline start
(+ start decl-len)
(+ start p)))
s)
(values (get-output-bytes s) decl-len p)))))
(values #f #f #f #f))])
s)
(values (get-output-bytes s) decl-len p)))))
(values #f #f #f #f))])
(if (and s e)
;; ELF succeeded:
;; ELF succeeded:
(values s (+ s dl) (+ s p) e)
;; Otherwise, just add to the end of the file:
(let ([start (file-size dest-exe)])
@ -1550,6 +1553,8 @@
(call-with-output-file* dest-exe write-module
#:exists 'append))
(values start decl-end (file-size dest-exe) #f)))))])
(when unix-starter?
(adjust-config-dir))
(when verbose?
(eprintf "Setting command line\n"))
(let ()