From a10cebff2e7fb98157737363d69aa8485e33f364 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Sat, 16 Oct 2004 16:01:00 +0000 Subject: [PATCH] . original commit: 3044c9a11598f23f13b14764d441124815d71d55 --- collects/tests/mzscheme/embed-me1.ss | 5 ++- collects/tests/mzscheme/embed-me2.ss | 5 ++- collects/tests/mzscheme/embed-me3.ss | 6 ++- collects/tests/mzscheme/embed-me4.ss | 5 ++- collects/tests/mzscheme/embed-me5.ss | 5 ++- collects/tests/mzscheme/embed.ss | 64 ++++++++++++++++------------ 6 files changed, 58 insertions(+), 32 deletions(-) diff --git a/collects/tests/mzscheme/embed-me1.ss b/collects/tests/mzscheme/embed-me1.ss index 5303b9f40e..7e2bb11748 100644 --- a/collects/tests/mzscheme/embed-me1.ss +++ b/collects/tests/mzscheme/embed-me1.ss @@ -1,2 +1,5 @@ (module embed-me1 mzscheme - (printf "This is 1~n")) + (with-output-to-file "stdout" + (lambda () (printf "This is 1~n")) + 'append)) + diff --git a/collects/tests/mzscheme/embed-me2.ss b/collects/tests/mzscheme/embed-me2.ss index f445236a3e..f0216b0381 100644 --- a/collects/tests/mzscheme/embed-me2.ss +++ b/collects/tests/mzscheme/embed-me2.ss @@ -1,6 +1,9 @@ (module embed-me2 mzscheme (require "embed-me1.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)) + diff --git a/collects/tests/mzscheme/embed-me3.ss b/collects/tests/mzscheme/embed-me3.ss index a65072db61..a68cf78d4a 100644 --- a/collects/tests/mzscheme/embed-me3.ss +++ b/collects/tests/mzscheme/embed-me3.ss @@ -1,3 +1,7 @@ (module embed-me3 mzscheme (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)) + diff --git a/collects/tests/mzscheme/embed-me4.ss b/collects/tests/mzscheme/embed-me4.ss index f2585bee92..24e22b0787 100644 --- a/collects/tests/mzscheme/embed-me4.ss +++ b/collects/tests/mzscheme/embed-me4.ss @@ -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) + diff --git a/collects/tests/mzscheme/embed-me5.ss b/collects/tests/mzscheme/embed-me5.ss index 690af08111..aaf471f21f 100644 --- a/collects/tests/mzscheme/embed-me5.ss +++ b/collects/tests/mzscheme/embed-me5.ss @@ -1,3 +1,6 @@ (module embed-me5 mzscheme (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)) + diff --git a/collects/tests/mzscheme/embed.ss b/collects/tests/mzscheme/embed.ss index 4da9fa5e4c..261fdc2071 100644 --- a/collects/tests/mzscheme/embed.ss +++ b/collects/tests/mzscheme/embed.ss @@ -23,10 +23,8 @@ (when (file-exists? exe) (delete-file exe))) -(define (try-exe exe expect) - (let ([out (open-output-bytes)] - [in (open-input-bytes #"")] - [plthome (getenv "PLTHOME")] +(define (try-exe exe expect mred?) + (let ([plthome (getenv "PLTHOME")] [collects (getenv "PLTCOLLECTS")]) ;; Try to hide usual collections: (when plthome @@ -34,17 +32,21 @@ (when collects (putenv "PLTCOLLECTS" (path->string (find-system-path 'temp-dir)))) ;; Execute: - (parameterize ([current-output-port out] - [current-input-port in]) + (parameterize ([current-directory (find-system-path 'temp-dir)]) + (when (file-exists? "stdout") + (delete-file "stdout")) (system* exe)) (when plthome (putenv "PLTHOME" plthome)) (when collects - (putenv "PLTCOLLECTS" "")) - (test expect get-output-string out))) + (putenv "PLTCOLLECTS" collects)) + (test expect with-input-from-file (build-path (find-system-path 'temp-dir) "stdout") + (lambda () (read-string 5000))))) (define (mz-tests mred?) (define dest (if mred? mr-dest mz-dest)) + (define (flags s) + (string-append "-" (if mred? "Z" "") "mvq" s)) (define (one-mz-test filename expect) ;; Try simple mode: one module, launched from cmd line: (prepare dest filename) @@ -53,8 +55,8 @@ `((#t (lib ,filename "tests" "mzscheme"))) null null - `("-mvqL" ,filename "tests/mzscheme")) - (try-exe dest expect) + `(,(flags "L") ,filename "tests/mzscheme")) + (try-exe dest expect mred?) ;; Try explicit prefix: (let ([w/prefix @@ -68,7 +70,7 @@ `("-mvqe" ,(format "(require ~a~a)" (or pfx "") (regexp-replace #rx"[.].*$" filename "")))) - (try-exe dest expect))]) + (try-exe dest expect mred?))]) (w/prefix #f) (w/prefix 'before:)) @@ -80,8 +82,8 @@ `((#t ,path)) null `(require (file ,(path->string path))) - `("-mvq"))) - (try-exe dest expect) + `(,(flags "")))) + (try-exe dest expect mred?) ;; Use `file' form: (prepare dest filename) @@ -91,8 +93,8 @@ `((#t (file ,(path->string path)))) null `(require (file ,(path->string path))) - `("-mvq"))) - (try-exe dest expect) + `(,(flags "")))) + (try-exe dest expect mred?) ;; Use relative path (prepare dest filename) @@ -102,8 +104,8 @@ `((#f ,filename)) null `(require ,(string->symbol (regexp-replace #rx"[.].*$" filename ""))) - `("-mvq"))) - (try-exe dest expect) + `(,(flags "")))) + (try-exe dest expect mred?) ;; Try multiple modules (prepare dest filename) @@ -115,8 +117,8 @@ `(begin (require (lib "embed-me3.ss" "tests" "mzscheme")) (require (lib ,filename "tests" "mzscheme"))) - `("-mvq")) - (try-exe dest (string-append "3 is here, too? #t\n" expect)) + `(,(flags ""))) + (try-exe dest (string-append "3 is here, too? #t\n" expect) mred?) ;; Try a literal file (prepare dest filename) @@ -124,12 +126,15 @@ 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")) + `(with-output-to-file "stdout" + (lambda () (display "... and more!\n")) + 'append) + `(,(flags "L") ,filename "tests/mzscheme")) (try-exe dest (string-append "This is the literal expression 4.\n" "... and more!\n" - expect))) + expect) + mred?)) (one-mz-test "embed-me1.ss" "This is 1\n") (one-mz-test "embed-me2.ss" "This is 1\nThis is 2: #t\n") @@ -137,12 +142,17 @@ ;; Try unicode expr and cmdline: (prepare dest "unicode") (make-embedding-executable - dest #f #f + dest mred? #f null null - `(printf "\uA9, \u7238, and \U1D670\n") - `("-mvqe" "(display \"\u7237...\U1D671\n\")")) - (try-exe dest "\uA9, \u7238, and \U1D670\n\u7237...\U1D671\n")) + `(begin + (define (out s) + (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 #t) @@ -154,6 +164,6 @@ null null `("-ZmvqL" "embed-me5.ss" "tests/mzscheme")) -(try-exe mr-dest "This is 5: #\n") +(try-exe mr-dest "This is 5: #\n" #t) (report-errs)