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

add --launcher'/-l' flag to `raco exe' to create launchers

Browse Source 
This addition triggered several other changes:

 * -k for a Mac OS X embedding is now relative to the __PLTSCHEME
   segment (which means that executables won't break if you strip
   them, for example)

 * the command-line no longer has a limited size for Mac OS X
   launchers and embedding executables

 * Mac OS X GUI and Windows launchers record the creation-time
   collection path, unless they are created as "relative" launchers

original commit: 2c479683d1
This commit is contained in:
Matthew Flatt 2012-02-13 14:30:30 -07:00
parent ee5fdf3771
commit 02d466aec0
2 changed files with 71 additions and 30 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

58
collects/compiler/commands/exe.rkt
View File

@ -10,6 +10,7 @@
(define gui (make-parameter #f)) (define gui (make-parameter #f))
(define 3m (make-parameter #t)) (define 3m (make-parameter #t))
(define launcher (make-parameter #f))
(define exe-output (make-parameter #f)) (define exe-output (make-parameter #f))
(define exe-embedded-flags (make-parameter '("-U" "--"))) (define exe-embedded-flags (make-parameter '("-U" "--")))
@ -26,6 +27,8 @@
(exe-output file)] (exe-output file)]
[("--gui") "Generate GUI executable" [("--gui") "Generate GUI executable"
(gui #t)] (gui #t)]
[("-l" "--launcher") "Generate a launcher"
(launcher #t)]
[("--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>"
@ -70,27 +73,38 @@
(extract-base-filename/ss source-file (extract-base-filename/ss source-file
(string->symbol (short-program+command-name)))) (string->symbol (short-program+command-name))))
(gui))]) (gui))])
(mzc:create-embedding-executable (cond
dest [(launcher)
#:mred? (gui) (parameterize ([current-launcher-variant (if (3m) '3m 'cgc)])
#:variant (if (3m) '3m 'cgc) ((if (gui)
#:verbose? (very-verbose) make-gracket-launcher
#:modules (cons `(#%mzc: (file ,source-file)) make-racket-launcher)
(map (lambda (l) `(#t (lib ,l))) (append (list "-t" (path->string (path->complete-path source-file)))
(exe-embedded-libraries))) (exe-embedded-flags))
#:configure-via-first-module? #t dest
#:literal-expression (exe-aux)))]
(parameterize ([current-namespace (make-base-namespace)]) [else
(compile (mzc:create-embedding-executable
`(namespace-require dest
'',(string->symbol #:mred? (gui)
(format "#%mzc:~a" #:variant (if (3m) '3m 'cgc)
(let-values ([(base name dir?) #:verbose? (very-verbose)
(split-path source-file)]) #:modules (cons `(#%mzc: (file ,source-file))
(path->bytes (path-replace-suffix name #"")))))))) (map (lambda (l) `(#t (lib ,l)))
#:cmdline (exe-embedded-flags) (exe-embedded-libraries)))
#:collects-path (exe-embedded-collects-path) #:configure-via-first-module? #t
#:collects-dest (exe-embedded-collects-dest) #:literal-expression
#:aux (exe-aux)) (parameterize ([current-namespace (make-base-namespace)])
(compile
`(namespace-require
'',(string->symbol
(format "#%mzc:~a"
(let-values ([(base name dir?)
(split-path source-file)])
(path->bytes (path-replace-suffix name #""))))))))
#:cmdline (exe-embedded-flags)
#:collects-path (exe-embedded-collects-path)
#:collects-dest (exe-embedded-collects-dest)
#:aux (exe-aux))])
(when (verbose) (when (verbose)
(printf " [output to \"~a\"]\n" dest))) (printf " [output to \"~a\"]\n" dest)))

43
collects/tests/racket/embed.rktl
View File

@ -6,6 +6,7 @@
(require compiler/embed (require compiler/embed
mzlib/file mzlib/file
mzlib/process mzlib/process
launcher
compiler/distribute) compiler/distribute)
(define (mk-dest-bin mred?) (define (mk-dest-bin mred?)
@ -67,12 +68,9 @@
(test expect with-input-from-file (build-path (find-system-path 'temp-dir) "stdout") (test expect with-input-from-file (build-path (find-system-path 'temp-dir) "stdout")
(lambda () (read-string 5000))))) (lambda () (read-string 5000)))))
(define try-exe (define (try-exe exe expect mred? [dist-hook void] #:dist? [dist? #t] . collects)
(case-lambda (try-one-exe exe expect mred?)
[(exe expect mred?) (when dist?
(try-exe exe expect mred? void)]
[(exe expect mred? dist-hook . collects)
(try-one-exe exe expect mred?)
;; Build a distirbution directory, and try that, too: ;; Build a distirbution directory, and try that, too:
(printf " ... from distribution ...\n") (printf " ... from distribution ...\n")
(when (directory-exists? dist-dir) (when (directory-exists? dist-dir)
@ -84,7 +82,7 @@
dist-mred-exe dist-mred-exe
dist-mz-exe)) dist-mz-exe))
expect mred?) expect mred?)
(delete-directory/files dist-dir)])) (delete-directory/files dist-dir)))
(define (base-compile e) (define (base-compile e)
(parameterize ([current-namespace (make-base-namespace)]) (parameterize ([current-namespace (make-base-namespace)])
@ -109,6 +107,13 @@
`(,(flags "l") ,(string-append "tests/racket/" filename))) `(,(flags "l") ,(string-append "tests/racket/" filename)))
(try-exe dest expect mred?) (try-exe dest expect mred?)
;; As a launcher:
(prepare dest filename)
((if mred? make-gracket-launcher make-racket-launcher)
(list "-l" (string-append "tests/racket/" filename))
dest)
(try-exe dest expect mred? #:dist? #f)
;; Try explicit prefix: ;; Try explicit prefix:
(printf ">>>explicit prefix\n") (printf ">>>explicit prefix\n")
(let ([w/prefix (let ([w/prefix
@ -250,16 +255,38 @@
`("-l" "tests/racket/embed-me5.rkt")) `("-l" "tests/racket/embed-me5.rkt"))
(try-exe mr-dest "This is 5: #<class:button%>\n" #t))) (try-exe mr-dest "This is 5: #<class:button%>\n" #t)))
;; Try the mzc interface: ;; Try the raco interface:
(require setup/dirs (require setup/dirs
mzlib/file) mzlib/file)
(define mzc (build-path (find-console-bin-dir) (if (eq? 'windows (system-type)) (define mzc (build-path (find-console-bin-dir) (if (eq? 'windows (system-type))
"mzc.exe" "mzc.exe"
"mzc"))) "mzc")))
(define raco (build-path (find-console-bin-dir) (if (eq? 'windows (system-type))
"raco.exe"
"raco")))
(define (mzc-tests mred?) (define (mzc-tests mred?)
(parameterize ([current-directory (find-system-path 'temp-dir)]) (parameterize ([current-directory (find-system-path 'temp-dir)])
;; raco exe
(system* raco
"exe"
"-o" (path->string (mk-dest mred?))
(if mred? "--gui" "--")
(path->string (build-path (collection-path "tests" "racket") "embed-me1.rkt")))
(try-exe (mk-dest mred?) "This is 1\n" mred?)
;;raco exe --launcher
(system* raco
"exe"
"--launcher"
"-o" (path->string (mk-dest mred?))
(if mred? "--gui" "--")
(path->string (build-path (collection-path "tests" "racket") "embed-me1.rkt")))
(try-exe (mk-dest mred?) "This is 1\n" mred? #:dist? #f)
;; the rest use mzc...
(system* mzc (system* mzc
(if mred? "--gui-exe" "--exe") (if mred? "--gui-exe" "--exe")
(path->string (mk-dest mred?)) (path->string (mk-dest mred?))