original commit: 3044c9a11598f23f13b14764d441124815d71d55
This commit is contained in:
Matthew Flatt 2004-10-16 16:01:00 +00:00
parent 9d4deab7b5
commit a10cebff2e
6 changed files with 58 additions and 32 deletions

View File

@ -1,2 +1,5 @@
(module embed-me1 mzscheme (module embed-me1 mzscheme
(printf "This is 1~n")) (with-output-to-file "stdout"
(lambda () (printf "This is 1~n"))
'append))

View File

@ -1,6 +1,9 @@
(module embed-me2 mzscheme (module embed-me2 mzscheme
(require "embed-me1.ss" (require "embed-me1.ss"
(lib "etc.ss")) (lib "etc.ss"))
(printf "This is 2: ~a~n" true)) (with-output-to-file "stdout"
(lambda () (printf "This is 2: ~a~n" true))
'append))

View File

@ -1,3 +1,7 @@
(module embed-me3 mzscheme (module embed-me3 mzscheme
(require (lib "etc.ss")) (require (lib "etc.ss"))
(printf "3 is here, too? ~a\n" true)) (with-output-to-file "stdout"
(lambda ()
(printf "3 is here, too? ~a\n" true))
'append))

View File

@ -1 +1,4 @@
(printf "This is the literal expression 4.\n") (with-output-to-file "stdout"
(lambda () (printf "This is the literal expression 4.\n"))
'append)

View File

@ -1,3 +1,6 @@
(module embed-me5 mzscheme (module embed-me5 mzscheme
(require (lib "mred.ss" "mred")) (require (lib "mred.ss" "mred"))
(printf "This is 5: ~s\n" button%)) (with-output-to-file "stdout"
(lambda () (printf "This is 5: ~s\n" button%))
'append))

View File

@ -23,10 +23,8 @@
(when (file-exists? exe) (when (file-exists? exe)
(delete-file exe))) (delete-file exe)))
(define (try-exe exe expect) (define (try-exe exe expect mred?)
(let ([out (open-output-bytes)] (let ([plthome (getenv "PLTHOME")]
[in (open-input-bytes #"")]
[plthome (getenv "PLTHOME")]
[collects (getenv "PLTCOLLECTS")]) [collects (getenv "PLTCOLLECTS")])
;; Try to hide usual collections: ;; Try to hide usual collections:
(when plthome (when plthome
@ -34,17 +32,21 @@
(when collects (when collects
(putenv "PLTCOLLECTS" (path->string (find-system-path 'temp-dir)))) (putenv "PLTCOLLECTS" (path->string (find-system-path 'temp-dir))))
;; Execute: ;; Execute:
(parameterize ([current-output-port out] (parameterize ([current-directory (find-system-path 'temp-dir)])
[current-input-port in]) (when (file-exists? "stdout")
(delete-file "stdout"))
(system* exe)) (system* exe))
(when plthome (when plthome
(putenv "PLTHOME" plthome)) (putenv "PLTHOME" plthome))
(when collects (when collects
(putenv "PLTCOLLECTS" "")) (putenv "PLTCOLLECTS" collects))
(test expect get-output-string out))) (test expect with-input-from-file (build-path (find-system-path 'temp-dir) "stdout")
(lambda () (read-string 5000)))))
(define (mz-tests mred?) (define (mz-tests mred?)
(define dest (if mred? mr-dest mz-dest)) (define dest (if mred? mr-dest mz-dest))
(define (flags s)
(string-append "-" (if mred? "Z" "") "mvq" s))
(define (one-mz-test filename expect) (define (one-mz-test filename expect)
;; Try simple mode: one module, launched from cmd line: ;; Try simple mode: one module, launched from cmd line:
(prepare dest filename) (prepare dest filename)
@ -53,8 +55,8 @@
`((#t (lib ,filename "tests" "mzscheme"))) `((#t (lib ,filename "tests" "mzscheme")))
null null
null null
`("-mvqL" ,filename "tests/mzscheme")) `(,(flags "L") ,filename "tests/mzscheme"))
(try-exe dest expect) (try-exe dest expect mred?)
;; Try explicit prefix: ;; Try explicit prefix:
(let ([w/prefix (let ([w/prefix
@ -68,7 +70,7 @@
`("-mvqe" ,(format "(require ~a~a)" `("-mvqe" ,(format "(require ~a~a)"
(or pfx "") (or pfx "")
(regexp-replace #rx"[.].*$" filename "")))) (regexp-replace #rx"[.].*$" filename ""))))
(try-exe dest expect))]) (try-exe dest expect mred?))])
(w/prefix #f) (w/prefix #f)
(w/prefix 'before:)) (w/prefix 'before:))
@ -80,8 +82,8 @@
`((#t ,path)) `((#t ,path))
null null
`(require (file ,(path->string path))) `(require (file ,(path->string path)))
`("-mvq"))) `(,(flags ""))))
(try-exe dest expect) (try-exe dest expect mred?)
;; Use `file' form: ;; Use `file' form:
(prepare dest filename) (prepare dest filename)
@ -91,8 +93,8 @@
`((#t (file ,(path->string path)))) `((#t (file ,(path->string path))))
null null
`(require (file ,(path->string path))) `(require (file ,(path->string path)))
`("-mvq"))) `(,(flags ""))))
(try-exe dest expect) (try-exe dest expect mred?)
;; Use relative path ;; Use relative path
(prepare dest filename) (prepare dest filename)
@ -102,8 +104,8 @@
`((#f ,filename)) `((#f ,filename))
null null
`(require ,(string->symbol (regexp-replace #rx"[.].*$" filename ""))) `(require ,(string->symbol (regexp-replace #rx"[.].*$" filename "")))
`("-mvq"))) `(,(flags ""))))
(try-exe dest expect) (try-exe dest expect mred?)
;; Try multiple modules ;; Try multiple modules
(prepare dest filename) (prepare dest filename)
@ -115,8 +117,8 @@
`(begin `(begin
(require (lib "embed-me3.ss" "tests" "mzscheme")) (require (lib "embed-me3.ss" "tests" "mzscheme"))
(require (lib ,filename "tests" "mzscheme"))) (require (lib ,filename "tests" "mzscheme")))
`("-mvq")) `(,(flags "")))
(try-exe dest (string-append "3 is here, too? #t\n" expect)) (try-exe dest (string-append "3 is here, too? #t\n" expect) mred?)
;; Try a literal file ;; Try a literal file
(prepare dest filename) (prepare dest filename)
@ -124,12 +126,15 @@
dest mred? #f dest mred? #f
`((#t (lib ,filename "tests" "mzscheme"))) `((#t (lib ,filename "tests" "mzscheme")))
(list (build-path (collection-path "tests" "mzscheme") "embed-me4.ss")) (list (build-path (collection-path "tests" "mzscheme") "embed-me4.ss"))
`(begin (display "... and more!\n")) `(with-output-to-file "stdout"
`("-mvqL" ,filename "tests/mzscheme")) (lambda () (display "... and more!\n"))
'append)
`(,(flags "L") ,filename "tests/mzscheme"))
(try-exe dest (string-append (try-exe dest (string-append
"This is the literal expression 4.\n" "This is the literal expression 4.\n"
"... and more!\n" "... and more!\n"
expect))) expect)
mred?))
(one-mz-test "embed-me1.ss" "This is 1\n") (one-mz-test "embed-me1.ss" "This is 1\n")
(one-mz-test "embed-me2.ss" "This is 1\nThis is 2: #t\n") (one-mz-test "embed-me2.ss" "This is 1\nThis is 2: #t\n")
@ -137,12 +142,17 @@
;; Try unicode expr and cmdline: ;; Try unicode expr and cmdline:
(prepare dest "unicode") (prepare dest "unicode")
(make-embedding-executable (make-embedding-executable
dest #f #f dest mred? #f
null null
null null
`(printf "\uA9, \u7238, and \U1D670\n") `(begin
`("-mvqe" "(display \"\u7237...\U1D671\n\")")) (define (out s)
(try-exe dest "\uA9, \u7238, and \U1D670\n\u7237...\U1D671\n")) (with-output-to-file "stdout"
(lambda () (printf s))
'append))
(out "\uA9, \u7238, and \U1D670\n"))
`(,(flags "e") "(out \"\u7237...\U1D671\n\")"))
(try-exe dest "\uA9, \u7238, and \U1D670\n\u7237...\U1D671\n" mred?))
(mz-tests #f) (mz-tests #f)
(mz-tests #t) (mz-tests #t)
@ -154,6 +164,6 @@
null null
null null
`("-ZmvqL" "embed-me5.ss" "tests/mzscheme")) `("-ZmvqL" "embed-me5.ss" "tests/mzscheme"))
(try-exe mr-dest "This is 5: #<struct:class:button%>\n") (try-exe mr-dest "This is 5: #<struct:class:button%>\n" #t)
(report-errs) (report-errs)