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))

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

@ -363,12 +363,13 @@
(path->string (build-path (collection-path "tests" "compiler" "embed") "embed-me1.rkt")))
(try-exe (mk-dest mred?) "This is 1\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") "embed-me6.rkt")))
(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:
@ -376,18 +377,33 @@
(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")))
"++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:
;; 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") "embed-me6.rkt")))
(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?)
;; 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?)
@ -396,13 +412,15 @@
(system* mzc
(if mred? "--gui-exe" "--exe")
(path->string (mk-dest mred?))
"++lib" "mzlib/etc.rkt"
"++lib" lib
"--collects-dest" "cts"
"--collects-path" "cts"
(path->string (build-path (collection-path "tests" "compiler" "embed") "embed-me6.rkt")))
(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?))
(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)

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

@ -1411,6 +1411,7 @@
(let-values ([(orig-dir name dir?) (split-path
(path->complete-path orig-exe))])
(update-dll-dir dest (build-path orig-dir dir))))))))
(define (adjust-config-dir)
(let ([m (or (assq 'config-dir aux)
(and relative? '(config-dir . #f)))]
[dest->executable (lambda (dest)
@ -1436,7 +1437,9 @@
(let-values ([(orig-dir name dir?) (split-path
(path->complete-path orig-exe))])
(update-config-dir (dest->executable dest)
(build-path orig-dir dir)))))))
(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)
@ -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 ()