From 6f0314b40cac0c44c79fe1d0da96f48c09ad10b0 Mon Sep 17 00:00:00 2001 From: Robby Findler Date: Thu, 24 Apr 2008 20:33:42 +0000 Subject: [PATCH] fixed some bugs svn: r9464 --- collects/tests/framework/README | 2 +- collects/tests/framework/framework-test-engine.ss | 7 +++++-- collects/tests/framework/keys.ss | 12 ++++++------ collects/tests/framework/main.ss | 12 +++++------- collects/tests/framework/test-suite-utils.ss | 13 ++++--------- 5 files changed, 21 insertions(+), 25 deletions(-) diff --git a/collects/tests/framework/README b/collects/tests/framework/README index c5db071ad7..528eb69622 100644 --- a/collects/tests/framework/README +++ b/collects/tests/framework/README @@ -1,4 +1,4 @@ -`(#| +(#| Framework Test Suite Overview Each tests will rely on the sucessfully completion of all of the ones diff --git a/collects/tests/framework/framework-test-engine.ss b/collects/tests/framework/framework-test-engine.ss index ea5da91c5b..122e6c312c 100644 --- a/collects/tests/framework/framework-test-engine.ss +++ b/collects/tests/framework/framework-test-engine.ss @@ -19,6 +19,8 @@ (get-output-string p)) (format "uncaught exn: ~s" x))) + (namespace-require 'scheme/gui) + (thread (lambda () (with-handlers ([(lambda (x) #t) @@ -27,10 +29,11 @@ (if (exn? x) (exn-message x) (format "~s" x))))]) - (let ([port (load + (let ([port (call-with-input-file (build-path (collection-path "tests" "framework") - "receive-sexps-port.ss"))]) + "receive-sexps-port.ss") + read)]) (debug-printf mr-tcp "about to connect to ~a~n" port) (let*-values ([(in out) (tcp-connect "127.0.0.1" port)]) (let loop () diff --git a/collects/tests/framework/keys.ss b/collects/tests/framework/keys.ss index f71dab6484..7c7a5643e8 100644 --- a/collects/tests/framework/keys.ss +++ b/collects/tests/framework/keys.ss @@ -11,7 +11,7 @@ '(let ([k (make-object keymap:aug-keymap%)]) (send k add-function "abc" void) (send k map-function "c:k" "abc") - (hash-table-map (send k get-map-function-table) list))))) + (hash-map (send k get-map-function-table) list))))) (test 'keymap:aug-keymap%/get-table/ht @@ -20,11 +20,11 @@ (lambda () (send-sexp-to-mred '(let ([k (make-object keymap:aug-keymap%)] - [ht (make-hash-table)]) + [ht (make-hasheq)]) (send k add-function "abc" void) (send k map-function "c:k" "abc") - (hash-table-put! ht 'c:k "def") - (hash-table-map (send k get-map-function-table/ht ht) list))))) + (hash-set! ht 'c:k "def") + (hash-map (send k get-map-function-table/ht ht) list))))) (test 'keymap:aug-keymap%/get-table/chain1 @@ -41,7 +41,7 @@ (send k2 map-function "c:k" "abc-k2") (send k chain-to-keymap k1 #t) (send k chain-to-keymap k2 #t) - (hash-table-map (send k get-map-function-table) list))))) + (hash-map (send k get-map-function-table) list))))) (test 'keymap:aug-keymap%/get-table/chain/2 @@ -56,7 +56,7 @@ (send k add-function "abc-k" void) (send k map-function "c:k" "abc-k") (send k chain-to-keymap k1 #t) - (hash-table-map (send k get-map-function-table) list))))) + (hash-map (send k get-map-function-table) list))))) (define (test-canonicalize name str1 str2) (test diff --git a/collects/tests/framework/main.ss b/collects/tests/framework/main.ss index 90831f74e0..13f5502e50 100644 --- a/collects/tests/framework/main.ss +++ b/collects/tests/framework/main.ss @@ -1,3 +1,4 @@ + (module main mzscheme (require launcher mzlib/cmdline @@ -16,19 +17,16 @@ (define all-files (map symbol->string - (load - (build-path - (collection-path "tests" "framework") - "README")))) + (call-with-input-file (build-path + (collection-path "tests" "framework") + "README") + read))) (define all? #f) (define 3m? #f) (define files-to-process null) (define command-line-flags `((once-each - [("--3m") - ,(lambda (flag) (use-3m #t)) - ("Run the tests using a 3m mred")] [("-a" "--all") ,(lambda (flag) (set! all? #t)) diff --git a/collects/tests/framework/test-suite-utils.ss b/collects/tests/framework/test-suite-utils.ss index 8f65d4cce1..a427ae7a46 100644 --- a/collects/tests/framework/test-suite-utils.ss +++ b/collects/tests/framework/test-suite-utils.ss @@ -15,7 +15,6 @@ load-framework-automatically shutdown-listener shutdown-mred mred-running? - use-3m send-sexp-to-mred queue-sexp-to-mred test wait-for-frame @@ -33,8 +32,6 @@ set-only-these-tests! get-only-these-tests) - (define use-3m (make-parameter #f)) - (define section-jump void) (define (set-section-jump! _s) (set! section-jump _s)) (define (reset-section-jump!) (set! section-jump #f)) @@ -66,7 +63,7 @@ (define listener (let loop () - (let ([port (load port-filename)]) + (let ([port (call-with-input-file port-filename read)]) (with-handlers ([exn:fail? (lambda (x) (let ([next (+ port 1)]) @@ -92,14 +89,11 @@ (lambda () (system* (path->string - (build-path (collection-path "mzlib") + (build-path (collection-path "scheme") 'up 'up "bin" - (if (use-3m) - "mred3m" - "mred"))) - "-mvqt" + "mred")) (path->string (build-path (collection-path "tests" "framework") "framework-test-engine.ss")))))] @@ -161,6 +155,7 @@ (or (regexp-match re:tcp-read-error (exn-message exn)) (regexp-match re:tcp-write-error (exn-message exn)))) + (namespace-require 'scheme/base) ;; in order to make the eval below work right. (define (send-sexp-to-mred sexp) (let/ec k (let ([show-text