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

fix problems with raco exe

Browse Source 
Merge to v5.0

original commit: 7442f14305
This commit is contained in:
Matthew Flatt 2010-05-26 17:05:33 -06:00
commit 2da4caee6c
1 changed files with 42 additions and 42 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -103,10 +103,10 @@
(prepare dest filename) (prepare dest filename)
(make-embedding-executable (make-embedding-executable
dest mred? #f dest mred? #f
`((#t (lib ,filename "tests" "mzscheme"))) `((#t (lib ,filename "tests" "racket")))
null null
#f #f
`(,(flags "l") ,(string-append "tests/mzscheme/" filename))) `(,(flags "l") ,(string-append "tests/racket/" filename)))
(try-exe dest expect mred?) (try-exe dest expect mred?)
;; Try explicit prefix: ;; Try explicit prefix:
@ -116,7 +116,7 @@
(prepare dest filename) (prepare dest filename)
(make-embedding-executable (make-embedding-executable
dest mred? #f dest mred? #f
`((,pfx (lib ,filename "tests" "mzscheme")) `((,pfx (lib ,filename "tests" "racket"))
(#t (lib "scheme/init"))) (#t (lib "scheme/init")))
null null
#f #f
@ -133,7 +133,7 @@
;; Try full path, and use literal S-exp to start ;; Try full path, and use literal S-exp to start
(printf ">>>literal sexp\n") (printf ">>>literal sexp\n")
(prepare dest filename) (prepare dest filename)
(let ([path (build-path (collection-path "tests" "mzscheme") filename)]) (let ([path (build-path (collection-path "tests" "racket") filename)])
(make-embedding-executable (make-embedding-executable
dest mred? #f dest mred? #f
`((#t ,path)) `((#t ,path))
@ -146,7 +146,7 @@
;; Use `file' form: ;; Use `file' form:
(printf ">>>file\n") (printf ">>>file\n")
(prepare dest filename) (prepare dest filename)
(let ([path (build-path (collection-path "tests" "mzscheme") filename)]) (let ([path (build-path (collection-path "tests" "racket") filename)])
(make-embedding-executable (make-embedding-executable
dest mred? #f dest mred? #f
`((#t (file ,(path->string path)))) `((#t (file ,(path->string path))))
@ -159,7 +159,7 @@
;; Use relative path ;; Use relative path
(printf ">>>relative path\n") (printf ">>>relative path\n")
(prepare dest filename) (prepare dest filename)
(parameterize ([current-directory (collection-path "tests" "mzscheme")]) (parameterize ([current-directory (collection-path "tests" "racket")])
(make-embedding-executable (make-embedding-executable
dest mred? #f dest mred? #f
`((#f ,filename)) `((#f ,filename))
@ -174,13 +174,13 @@
(prepare dest filename) (prepare dest filename)
(make-embedding-executable (make-embedding-executable
dest mred? #f dest mred? #f
`((#t (lib ,filename "tests" "mzscheme")) `((#t (lib ,filename "tests" "racket"))
(#t (lib "embed-me3.ss" "tests" "mzscheme"))) (#t (lib "embed-me3.rkt" "tests" "racket")))
null null
(base-compile (base-compile
`(begin `(begin
(namespace-require '(lib "embed-me3.ss" "tests" "mzscheme")) (namespace-require '(lib "embed-me3.rkt" "tests" "racket"))
(namespace-require '(lib ,filename "tests" "mzscheme")))) (namespace-require '(lib ,filename "tests" "racket"))))
`(,(flags ""))) `(,(flags "")))
(try-exe dest (string-append "3 is here, too? #t\n" expect) mred?) (try-exe dest (string-append "3 is here, too? #t\n" expect) mred?)
@ -195,14 +195,14 @@
'(namespace-require ''#%kernel))))) '(namespace-require ''#%kernel)))))
(make-embedding-executable (make-embedding-executable
dest mred? #f dest mred? #f
`((#t (lib ,filename "tests" "mzscheme"))) `((#t (lib ,filename "tests" "racket")))
(list (list
tmp tmp
(build-path (collection-path "tests" "mzscheme") "embed-me4.ss")) (build-path (collection-path "tests" "racket") "embed-me4.rktl"))
`(with-output-to-file "stdout" `(with-output-to-file "stdout"
(lambda () (display "... and more!\n")) (lambda () (display "... and more!\n"))
'append) 'append)
`(,(flags "l") ,(string-append "tests/mzscheme/" filename))) `(,(flags "l") ,(string-append "tests/racket/" filename)))
(delete-file tmp)) (delete-file tmp))
(try-exe dest (string-append (try-exe dest (string-append
"This is the literal expression 4.\n" "This is the literal expression 4.\n"
@ -210,12 +210,12 @@
expect) expect)
mred?))) mred?)))
(one-mz-test "embed-me1.ss" "This is 1\n" #t) (one-mz-test "embed-me1.rkt" "This is 1\n" #t)
(one-mz-test "embed-me1b.ss" "This is 1b\n" #f) (one-mz-test "embed-me1b.rkt" "This is 1b\n" #f)
(one-mz-test "embed-me1c.ss" "This is 1c\n" #f) (one-mz-test "embed-me1c.rkt" "This is 1c\n" #f)
(one-mz-test "embed-me1d.ss" "This is 1d\n" #f) (one-mz-test "embed-me1d.rkt" "This is 1d\n" #f)
(one-mz-test "embed-me1e.ss" "This is 1e\n" #f) (one-mz-test "embed-me1e.rkt" "This is 1e\n" #f)
(one-mz-test "embed-me2.ss" "This is 1\nThis is 2: #t\n" #t) (one-mz-test "embed-me2.rkt" "This is 1\nThis is 2: #t\n" #t)
;; Try unicode expr and cmdline: ;; Try unicode expr and cmdline:
(prepare dest "unicode") (prepare dest "unicode")
@ -238,13 +238,13 @@
(mz-tests #t) (mz-tests #t)
(begin (begin
(prepare mr-dest "embed-me5.ss") (prepare mr-dest "embed-me5.rkt")
(make-embedding-executable (make-embedding-executable
mr-dest #t #f mr-dest #t #f
`((#t (lib "embed-me5.ss" "tests" "mzscheme"))) `((#t (lib "embed-me5.rkt" "tests" "racket")))
null null
#f #f
`("-l" "tests/mzscheme/embed-me5.ss")) `("-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 mzc interface:
@ -260,15 +260,15 @@
(system* mzc (system* mzc
(if mred? "--gui-exe" "--exe") (if mred? "--gui-exe" "--exe")
(path->string (mk-dest mred?)) (path->string (mk-dest mred?))
(path->string (build-path (collection-path "tests" "mzscheme") "embed-me1.ss"))) (path->string (build-path (collection-path "tests" "racket") "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.ss isn't found if it's not included: ;; Check that etc.rkt isn't found if it's not included:
(printf ">>not included\n") (printf ">>not 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?))
(path->string (build-path (collection-path "tests" "mzscheme") "embed-me6.ss"))) (path->string (build-path (collection-path "tests" "racket") "embed-me6.rkt")))
(try-exe (mk-dest mred?) "This is 6\nno etc.ss\n" mred?) (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:
@ -276,8 +276,8 @@
(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.ss" "++lib" "mzlib/etc.rkt"
(path->string (build-path (collection-path "tests" "mzscheme") "embed-me6.ss"))) (path->string (build-path (collection-path "tests" "racket") "embed-me6.rkt")))
(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:
@ -287,7 +287,7 @@
(path->string (mk-dest mred?)) (path->string (mk-dest mred?))
"--collects-path" "--collects-path"
(path->string (find-collects-dir)) (path->string (find-collects-dir))
(path->string (build-path (collection-path "tests" "mzscheme") "embed-me6.ss"))) (path->string (build-path (collection-path "tests" "racket") "embed-me6.rkt")))
;; Don't try a distribution for this one: ;; Don't try a distribution for this one:
(try-one-exe (mk-dest mred?) "This is 6\n#t\n" mred?) (try-one-exe (mk-dest mred?) "This is 6\n#t\n" mred?)
@ -296,10 +296,10 @@
(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.ss" "++lib" "mzlib/etc.rkt"
"--collects-dest" "cts" "--collects-dest" "cts"
"--collects-path" "cts" "--collects-path" "cts"
(path->string (build-path (collection-path "tests" "mzscheme") "embed-me6.ss"))) (path->string (build-path (collection-path "tests" "racket") "embed-me6.rkt")))
(try-exe (mk-dest mred?) "This is 6\n#t\n" mred? void "cts") ; <- cts copied to distribution (try-exe (mk-dest mred?) "This is 6\n#t\n" mred? void "cts") ; <- cts copied to distribution
(delete-directory/files "cts") (delete-directory/files "cts")
(test #f system* (mk-dest mred?)) (test #f system* (mk-dest mred?))
@ -326,17 +326,17 @@
(system-library-subpath))) (system-library-subpath)))
(define ext-file (define ext-file
(build-path ext-dir (append-extension-suffix "embed-me8_ss"))) (build-path ext-dir (append-extension-suffix "embed-me8_rkt")))
(define ss-file (define ss-file
(build-path (find-system-path 'temp-dir) "embed-me9.ss")) (build-path (find-system-path 'temp-dir) "embed-me9.rkt"))
(make-directory* ext-dir) (make-directory* ext-dir)
(system* mzc (system* mzc
"--cc" "--cc"
"-d" (path->string (path-only obj-file)) "-d" (path->string (path-only obj-file))
(path->string (build-path (collection-path "tests" "mzscheme") "embed-me8.c"))) (path->string (build-path (collection-path "tests" "racket") "embed-me8.c")))
(system* mzc (system* mzc
"--ld" "--ld"
(path->string ext-file) (path->string ext-file)
@ -344,7 +344,7 @@
(when (file-exists? ss-file) (when (file-exists? ss-file)
(delete-file ss-file)) (delete-file ss-file))
(copy-file (build-path (collection-path "tests" "mzscheme") "embed-me9.ss") (copy-file (build-path (collection-path "tests" "racket") "embed-me9.rkt")
ss-file) ss-file)
(system* mzc (system* mzc
@ -361,7 +361,7 @@
(system* mzc (system* mzc
(if mred? "--gui-exe" "--exe") (if mred? "--gui-exe" "--exe")
(path->string (mk-dest mred?)) (path->string (mk-dest mred?))
(path->string (build-path (collection-path "tests" "mzscheme") "embed-me10.ss"))) (path->string (build-path (collection-path "tests" "racket") "embed-me10.rkt")))
(try-exe (mk-dest mred?) "#t\n" mred?))) (try-exe (mk-dest mred?) "#t\n" mred?)))
(extension-test #f) (extension-test #f)
@ -372,7 +372,7 @@
(system* mzc (system* mzc
"--gui-exe" "--gui-exe"
(path->string (mk-dest #t)) (path->string (mk-dest #t))
(path->string (build-path (collection-path "tests" "mzscheme") "embed-me5.ss"))) (path->string (build-path (collection-path "tests" "racket") "embed-me5.rkt")))
(try-exe (mk-dest #t) "This is 5: #<class:button%>\n" #t)) (try-exe (mk-dest #t) "This is 5: #<class:button%>\n" #t))
;; Another GRacket-specific: try embedding plot, which has extra DLLs and font files: ;; Another GRacket-specific: try embedding plot, which has extra DLLs and font files:
@ -382,34 +382,34 @@
(test #t (test #t
system* (build-path (find-console-bin-dir) "mred") system* (build-path (find-console-bin-dir) "mred")
"-qu" "-qu"
(path->string (build-path (collection-path "tests" "mzscheme") "embed-me7.ss")) (path->string (build-path (collection-path "tests" "racket") "embed-me7.rkt"))
(path->string direct)) (path->string direct))
(system* mzc (system* mzc
"--gui-exe" "--gui-exe"
(path->string (mk-dest #t)) (path->string (mk-dest #t))
(path->string (build-path (collection-path "tests" "mzscheme") "embed-me7.ss"))) (path->string (build-path (collection-path "tests" "racket") "embed-me7.rkt")))
(try-exe (mk-dest #t) "plotted\n" #t)) (try-exe (mk-dest #t) "plotted\n" #t))
;; Try including source that needs a reader extension ;; Try including source that needs a reader extension
(define (try-reader-test mred?) (define (try-reader-test mred?)
(define dest (mk-dest mred?)) (define dest (mk-dest mred?))
(define filename "embed-me11.ss") (define filename "embed-me11.rkt")
(define (flags s) (define (flags s)
(string-append "-" s)) (string-append "-" s))
(create-embedding-executable (create-embedding-executable
dest dest
#:modules `((#t (lib ,filename "tests" "mzscheme"))) #:modules `((#t (lib ,filename "tests" "racket")))
#:cmdline `(,(flags "l") ,(string-append "tests/mzscheme/" filename)) #:cmdline `(,(flags "l") ,(string-append "tests/racket/" filename))
#:src-filter (lambda (f) #:src-filter (lambda (f)
(let-values ([(base name dir?) (split-path f)]) (let-values ([(base name dir?) (split-path f)])
(equal? name (string->path filename)))) (equal? name (string->path filename))))
#:get-extra-imports (lambda (f code) #:get-extra-imports (lambda (f code)
(let-values ([(base name dir?) (split-path f)]) (let-values ([(base name dir?) (split-path f)])
(if (equal? name (string->path filename)) (if (equal? name (string->path filename))
'((lib "embed-me11-rd.ss" "tests" "mzscheme")) '((lib "embed-me11-rd.rkt" "tests" "racket"))
null))) null)))
#:mred? mred?) #:mred? mred?)