fixed some bugs

svn: r9464

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

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 ()

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-set! ht 'c:k "def")
-         (hash-table-map (send k get-map-function-table/ht ht) list)))))
+         (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

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
+         (call-with-input-file (build-path
-	  (build-path
+                                (collection-path "tests" "framework")
-	   (collection-path "tests" "framework")
+                                "README")
-	   "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))

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)
+                        "mred"))
-                            "mred3m"
-                            "mred")))
-           "-mvqt"
            (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