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-flags (make-parameter '("-U" "--")))
(define exe-embedded-libraries (make-parameter null)) (define exe-embedded-libraries (make-parameter null))
(define exe-aux (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-path (make-parameter null))
(define exe-embedded-collects-dest (make-parameter #f)) (define exe-embedded-collects-dest (make-parameter #f))
@ -29,6 +30,8 @@
(gui #t)] (gui #t)]
[("-l" "--launcher") "Generate a launcher" [("-l" "--launcher") "Generate a launcher"
(launcher #t)] (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" [("--collects-path") path "Set <path> as main collects for executable"
(exe-embedded-collects-path path)] (exe-embedded-collects-path path)]
[("--collects-dest") dir "Write collection code to <dir>" [("--collects-dest") dir "Write collection code to <dir>"
@ -133,6 +136,7 @@
#:cmdline (exe-embedded-flags) #:cmdline (exe-embedded-flags)
#:collects-path (exe-embedded-collects-path) #:collects-path (exe-embedded-collects-path)
#:collects-dest (exe-embedded-collects-dest) #:collects-dest (exe-embedded-collects-dest)
#:aux (exe-aux))]) #:aux (cons `(config-dir . ,(exe-embedded-config-path))
(exe-aux)))])
(when (verbose) (when (verbose)
(printf " [output to \"~a\"]\n" dest))) (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"))) (path->string (build-path (collection-path "tests" "compiler" "embed") "embed-me1.rkt")))
(try-exe (mk-dest mred?) "This is 1\n" mred?) (try-exe (mk-dest mred?) "This is 1\n" mred?)
;; Check that etc.rkt isn't found if it's not included: (define (check-collection-path prog lib in-main?)
(printf ">>not included\n") ;; Check that etc.rkt isn't found if it's not included:
(system* mzc (printf ">>not included\n")
(if mred? "--gui-exe" "--exe") (system* mzc
(path->string (mk-dest mred?)) (if mred? "--gui-exe" "--exe")
(path->string (build-path (collection-path "tests" "compiler" "embed") "embed-me6.rkt"))) (path->string (mk-dest mred?))
(try-exe (mk-dest mred?) "This is 6\nno etc.ss\n" 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: ;; And it is found if it is included:
(printf ">>included\n") (printf ">>included\n")
(system* mzc (system* mzc
(if mred? "--gui-exe" "--exe") (if mred? "--gui-exe" "--exe")
(path->string (mk-dest mred?)) (path->string (mk-dest mred?))
"++lib" "mzlib/etc.rkt" "++lib" lib
(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?) (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
(printf ">>set coll path\n") ;; finds links for packages):
(system* mzc (printf ">>set coll path\n")
(if mred? "--gui-exe" "--exe") (system* mzc
(path->string (mk-dest mred?)) (if mred? "--gui-exe" "--exe")
"--collects-path" (path->string (mk-dest mred?))
(path->string (find-collects-dir)) "--collects-path"
(path->string (build-path (collection-path "tests" "compiler" "embed") "embed-me6.rkt"))) (path->string (find-collects-dir))
;; Don't try a distribution for this one: (path->string (build-path (collection-path "tests" "compiler" "embed") prog)))
(try-one-exe (mk-dest mred?) "This is 6\n#t\n" mred?) ;; 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 ;; Or, it's found if we set the collection path and the config path (where the latter
(printf ">>--collects-dest\n") ;; finds links for packages):
(system* mzc (printf ">>set coll path plus config\n")
(if mred? "--gui-exe" "--exe") (system* mzc
(path->string (mk-dest mred?)) (if mred? "--gui-exe" "--exe")
"++lib" "mzlib/etc.rkt" (path->string (mk-dest mred?))
"--collects-dest" "cts" "--collects-path"
"--collects-path" "cts" (path->string (find-collects-dir))
(path->string (build-path (collection-path "tests" "compiler" "embed") "embed-me6.rkt"))) "--config-path"
(try-exe (mk-dest mred?) "This is 6\n#t\n" mred? void "cts") ; <- cts copied to distribution (path->string (find-config-dir))
(delete-directory/files "cts") (path->string (build-path (collection-path "tests" "compiler" "embed") prog)))
(test #f system* (mk-dest mred?)) ;; 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))) (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-flags (make-parameter '("-U" "--")))
(define exe-embedded-libraries (make-parameter null)) (define exe-embedded-libraries (make-parameter null))
(define exe-aux (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-path (make-parameter #f))
(define exe-embedded-collects-dest (make-parameter #f)) (define exe-embedded-collects-dest (make-parameter #f))
(define exe-dir-add-collects-dirs (make-parameter null)) (define exe-dir-add-collects-dirs (make-parameter null))
@ -196,6 +197,10 @@
[help-labels [help-labels
"--------------------- executable configuration flags ------------------------"] "--------------------- executable configuration flags ------------------------"]
[once-each [once-each
[("--config-path")
,(lambda (f i)
(exe-embedded-config-path i))
("Set <path> configuration directory path in --[gui-]exe" "path")]
[("--collects-path") [("--collects-path")
,(lambda (f i) ,(lambda (f i)
(exe-embedded-collects-path i)) (exe-embedded-collects-path i))
@ -536,7 +541,8 @@
#:cmdline (exe-embedded-flags) #:cmdline (exe-embedded-flags)
#:collects-path (exe-embedded-collects-path) #:collects-path (exe-embedded-collects-path)
#:collects-dest (exe-embedded-collects-dest) #:collects-dest (exe-embedded-collects-dest)
#:aux (exe-aux)) #:aux (cons `(config-dir . ,(exe-embedded-config-path))
(exe-aux)))
(when (compiler:option:somewhat-verbose) (when (compiler:option:somewhat-verbose)
(printf " [output to \"~a\"]\n" dest)))] (printf " [output to \"~a\"]\n" dest)))]
[(c-mods) [(c-mods)

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

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