.
original commit: 496cc6747d89286ee1b25ff0412f651ba8e56b9e
This commit is contained in:
parent
e2730ac136
commit
8030d5c63b
2
collects/tests/mzscheme/embed-me1.ss
Normal file
2
collects/tests/mzscheme/embed-me1.ss
Normal file
|
@ -0,0 +1,2 @@
|
||||||
|
(module embed-me1 mzscheme
|
||||||
|
(printf "This is 1~n"))
|
6
collects/tests/mzscheme/embed-me2.ss
Normal file
6
collects/tests/mzscheme/embed-me2.ss
Normal file
|
@ -0,0 +1,6 @@
|
||||||
|
(module embed-me2 mzscheme
|
||||||
|
(require "embed-me1.ss"
|
||||||
|
(lib "etc.ss"))
|
||||||
|
(printf "This is 2: ~a~n" true))
|
||||||
|
|
||||||
|
|
3
collects/tests/mzscheme/embed-me3.ss
Normal file
3
collects/tests/mzscheme/embed-me3.ss
Normal file
|
@ -0,0 +1,3 @@
|
||||||
|
(module embed-me3 mzscheme
|
||||||
|
(require (lib "etc.ss"))
|
||||||
|
(printf "3 is here, too? ~a\n" true))
|
1
collects/tests/mzscheme/embed-me4.ss
Normal file
1
collects/tests/mzscheme/embed-me4.ss
Normal file
|
@ -0,0 +1 @@
|
||||||
|
(printf "This is the literal expression 4.\n")
|
139
collects/tests/mzscheme/embed.ss
Normal file
139
collects/tests/mzscheme/embed.ss
Normal file
|
@ -0,0 +1,139 @@
|
||||||
|
|
||||||
|
(load-relative "loadtest.ss")
|
||||||
|
|
||||||
|
(SECTION 'embed)
|
||||||
|
|
||||||
|
(require (lib "embed.ss" "compiler")
|
||||||
|
(lib "process.ss"))
|
||||||
|
|
||||||
|
(define (mk-dest mred?)
|
||||||
|
(build-path (find-system-path 'temp-dir)
|
||||||
|
(case (system-type)
|
||||||
|
[(windows) "e.exe"]
|
||||||
|
[(unix) "e"]
|
||||||
|
[(macosx) (if mred?
|
||||||
|
"e.app"
|
||||||
|
"e")])))
|
||||||
|
|
||||||
|
(define mz-dest (mk-dest #f))
|
||||||
|
(define mr-dest (mk-dest #t))
|
||||||
|
|
||||||
|
(define (prepare exe src)
|
||||||
|
(printf "Making ~a with ~a...~n" exe src)
|
||||||
|
(when (file-exists? exe)
|
||||||
|
(delete-file exe)))
|
||||||
|
|
||||||
|
(define (try-exe exe expect)
|
||||||
|
(let ([out (open-output-bytes)]
|
||||||
|
[in (open-input-bytes #"")])
|
||||||
|
(parameterize ([current-output-port out]
|
||||||
|
[current-input-port in])
|
||||||
|
(system* exe))
|
||||||
|
(test expect get-output-string out)))
|
||||||
|
|
||||||
|
|
||||||
|
(define (mz-tests mred?)
|
||||||
|
(define (one-mz-test filename expect)
|
||||||
|
;; Try simple mode: one module, launched from cmd line:
|
||||||
|
(prepare mz-dest filename)
|
||||||
|
(make-embedding-executable
|
||||||
|
mz-dest mred? #f
|
||||||
|
`((#t (lib ,filename "tests" "mzscheme")))
|
||||||
|
null
|
||||||
|
null
|
||||||
|
`("-mvqL" ,filename "tests/mzscheme"))
|
||||||
|
(try-exe mz-dest expect)
|
||||||
|
|
||||||
|
;; Try explicit prefix:
|
||||||
|
(let ([w/prefix
|
||||||
|
(lambda (pfx)
|
||||||
|
(prepare mz-dest filename)
|
||||||
|
(make-embedding-executable
|
||||||
|
mz-dest mred? #f
|
||||||
|
`((,pfx (lib ,filename "tests" "mzscheme")))
|
||||||
|
null
|
||||||
|
null
|
||||||
|
`("-mvqe" ,(format "(require ~a~a)"
|
||||||
|
(or pfx "")
|
||||||
|
(regexp-replace #rx"[.].*$" filename ""))))
|
||||||
|
(try-exe mz-dest expect))])
|
||||||
|
(w/prefix #f)
|
||||||
|
(w/prefix 'before:))
|
||||||
|
|
||||||
|
;; Try full path, and use literal S-exp to start
|
||||||
|
(prepare mz-dest filename)
|
||||||
|
(let ([path (build-path (collection-path "tests" "mzscheme") filename)])
|
||||||
|
(make-embedding-executable
|
||||||
|
mz-dest mred? #f
|
||||||
|
`((#t ,path))
|
||||||
|
null
|
||||||
|
`(require (file ,(path->string path)))
|
||||||
|
`("-mvq")))
|
||||||
|
(try-exe mz-dest expect)
|
||||||
|
|
||||||
|
;; Use `file' form:
|
||||||
|
(prepare mz-dest filename)
|
||||||
|
(let ([path (build-path (collection-path "tests" "mzscheme") filename)])
|
||||||
|
(make-embedding-executable
|
||||||
|
mz-dest mred? #f
|
||||||
|
`((#t (file ,(path->string path))))
|
||||||
|
null
|
||||||
|
`(require (file ,(path->string path)))
|
||||||
|
`("-mvq")))
|
||||||
|
(try-exe mz-dest expect)
|
||||||
|
|
||||||
|
;; Use relative path
|
||||||
|
(prepare mz-dest filename)
|
||||||
|
(parameterize ([current-directory (collection-path "tests" "mzscheme")])
|
||||||
|
(make-embedding-executable
|
||||||
|
mz-dest mred? #f
|
||||||
|
`((#f ,filename))
|
||||||
|
null
|
||||||
|
`(require ,(string->symbol (regexp-replace #rx"[.].*$" filename "")))
|
||||||
|
`("-mvq")))
|
||||||
|
(try-exe mz-dest expect)
|
||||||
|
|
||||||
|
;; Try multiple modules
|
||||||
|
(prepare mz-dest filename)
|
||||||
|
(make-embedding-executable
|
||||||
|
mz-dest mred? #f
|
||||||
|
`((#t (lib ,filename "tests" "mzscheme"))
|
||||||
|
(#t (lib "embed-me3.ss" "tests" "mzscheme")))
|
||||||
|
null
|
||||||
|
`(begin
|
||||||
|
(require (lib "embed-me3.ss" "tests" "mzscheme"))
|
||||||
|
(require (lib ,filename "tests" "mzscheme")))
|
||||||
|
`("-mvq"))
|
||||||
|
(try-exe mz-dest (string-append "3 is here, too? #t\n" expect))
|
||||||
|
|
||||||
|
;; Try a literal file
|
||||||
|
(prepare mz-dest filename)
|
||||||
|
(make-embedding-executable
|
||||||
|
mz-dest mred? #f
|
||||||
|
`((#t (lib ,filename "tests" "mzscheme")))
|
||||||
|
(list (build-path (collection-path "tests" "mzscheme") "embed-me4.ss"))
|
||||||
|
`(begin (display "... and more!\n"))
|
||||||
|
`("-mvqL" ,filename "tests/mzscheme"))
|
||||||
|
(try-exe mz-dest (string-append
|
||||||
|
"This is the literal expression 4.\n"
|
||||||
|
"... and more!\n"
|
||||||
|
expect)))
|
||||||
|
|
||||||
|
(one-mz-test "embed-me1.ss" "This is 1\n")
|
||||||
|
(one-mz-test "embed-me2.ss" "This is 1\nThis is 2: #t\n")
|
||||||
|
|
||||||
|
;; Try unicode expr and cmdline:
|
||||||
|
(prepare mz-dest "unicode")
|
||||||
|
(make-embedding-executable
|
||||||
|
mz-dest #f #f
|
||||||
|
null
|
||||||
|
null
|
||||||
|
`(printf "\uA9, \u7238, and \U1D670\n")
|
||||||
|
`("-mvqe" "(display \"\u7237...\U1D671\n\")"))
|
||||||
|
(try-exe mz-dest "\uA9, \u7238, and \U1D670\n\u7237...\U1D671\n"))
|
||||||
|
|
||||||
|
|
||||||
|
(mz-tests #f)
|
||||||
|
(mz-tests #t)
|
||||||
|
|
||||||
|
(report-errs)
|
Loading…
Reference in New Issue
Block a user