..

original commit: a93d981ed11674b7464245c7ed7ca7f3bf503fe1

collects/framework/test.ss

@@ -669,7 +669,8 @@
   
   (define key-tag 'test:keystroke)
   (define legal-keystroke-modifiers
-    (list 'alt 'control 'meta 'shift 'noalt 'nocontrol 'nometa 'noshift))
+    (list 'alt 'control 'meta 'shift
+          'noalt 'nocontrol 'nometa 'noshift))
 
   (define valid-key-symbols
     (list 'start 'cancel 'clear 'shift 'control 'menu 'pause 'capital

collects/tests/framework/README

@@ -58,7 +58,7 @@ test as last time, or `all' to run all of the tests.
   - edits to canvases: |# edit-canvas.ss #|
   - canvases to frames: |# canvas-frame.ss #|
   - edits to frames: |# edit-frame.ss #|
-  - handler |# handler-test.ss #|
+  - handler: handler-test.ss
 
 - keybindings: |# keys.ss #|
 

collects/tests/framework/frame.ss

@@ -136,10 +136,10 @@
        (send-sexp-to-mred
 	`(begin (send (find-labelled-window "Full pathname") focus)
 		,(case (system-type)
-		   [(macos) `(test:keystroke #\a '(meta))]
+		   [(macos macosx) `(test:keystroke #\a '(meta))]
 		   [(unix) `(test:keystroke #\a '(meta))]
 		   [(windows) `(test:keystroke #\a '(control))]
-		   [else (error "unknown system type: ~a" (system-type))])
+		   [else (error 'file-open-dialog "unknown system type: ~a" (system-type))])
 		(for-each test:keystroke
 			  (string->list ,tmp-file))
 		(test:keystroke #\return)))

collects/tests/framework/load.ss

@@ -23,7 +23,6 @@
             (void))))))
 
  
-  (test/load "specs.ss" '(contract (lambda (x) #t) 1 'pos 'neg))
   (test/load "gui-utils.ss" 'gui-utils:next-untitled-name)
   (test/load "test.ss" 'test:run-interval)
   (test/load "macro.ss" '(mixin () () ()))
@@ -34,8 +33,7 @@
   (test/load "framework.ss" '(list test:button-push
 				   gui-utils:next-untitled-name
 				   frame:basic-mixin
-                                   (mixin () () ())
+                                   (mixin () () ())))
-                                   (contract (lambda (x) #t) 1 'pos 'neg)))
   
   ;; ensures that all of the names in the signature are provided
   ;; by (require (lib "framework.ss" "framework"))

collects/tests/framework/main.ss

@@ -35,28 +35,11 @@
 					(or (get-only-these-tests) null))))
 	("Only run test named <test-name>" "test-name")])))
       
-  (define saved-command-line-file (build-path (collection-path "tests" "framework")
+  (parse-command-line "framework-test" argv command-line-flags
-					      "saved-command-line.ss"))
-  (define parsed-argv
-    (if (equal? argv (vector))
-	(if (file-exists? saved-command-line-file)
-	    (begin
-	      (let ([result (call-with-input-file saved-command-line-file read)])
-		(debug-printf admin "reusing command-line arguments: ~s~n" result)
-		result))
-	    (vector))
-	argv))
-
-  (parse-command-line "framework-test" parsed-argv command-line-flags
 		      (lambda (collected . files)
 			(set! files-to-process (if (or all? (null? files)) all-files files)))
 		      `("Names of the tests; defaults to all tests"))
 
-  (call-with-output-file saved-command-line-file
-    (lambda (port)
-      (write parsed-argv port))
-    'truncate)
-
   (when (file-exists? preferences-file)
     (debug-printf admin "  saving preferences file ~s to ~s~n" preferences-file old-preferences-file)
     (if (file-exists? old-preferences-file)

collects/tests/framework/test-suite-utils.ss

@@ -1,3 +1,4 @@
+
 (module test-suite-utils mzscheme
   (require (lib "launcher.ss" "launcher")
 	   (lib "pretty.ss")
@@ -82,10 +83,17 @@
 
   (define (restart-mred)
     (shutdown-mred)
-    ((case (system-type)
+    (case (system-type)
-       [(macos) system*]
+      [(macos) (system* (mred-program-launcher-path "Framework Test Engine"))]
-       [else (lambda (x) (thread (lambda () (system* x))))])
+      [(macosx)
-     (mred-program-launcher-path "Framework Test Engine"))
+       (thread
+        (lambda ()
+          (system*
+           (build-path (collection-path "mzlib") 'up 'up "bin" "mred")
+           "-mvqt"
+           (build-path (collection-path "tests" "framework")
+                       "framework-test-engine.ss"))))]
+      [else (thread (lambda () (system* (mred-program-launcher-path "Framework Test Engine"))))])
     (debug-printf mz-tcp "accepting listener~n")
     (let-values ([(in out) (tcp-accept listener)])
       (set! in-port in)