From 659386037e559b49028ccc217f7cc9fd5f514e36 Mon Sep 17 00:00:00 2001
From: Robby Findler <robby@racket-lang.org>
Date: Mon, 12 Mar 2001 03:30:19 +0000
Subject: [PATCH] ...

original commit: e4997679f50be40549e89cd02f6402aae26fa376
---
 collects/framework/gui-utils.ss              |  2 +-
 collects/tests/framework/debug.ss            |  4 ++--
 collects/tests/framework/load.ss             |  2 +-
 collects/tests/framework/test-suite-utils.ss | 25 ++++++++++----------
 4 files changed, 16 insertions(+), 17 deletions(-)

diff --git a/collects/framework/gui-utils.ss b/collects/framework/gui-utils.ss
index 03f4c7c6..4dbd6c60 100644
--- a/collects/framework/gui-utils.ss
+++ b/collects/framework/gui-utils.ss
@@ -9,6 +9,6 @@
 
   (define-values/invoke-unit/sig 
     framework:gui-utils^
-    gui-utils@
+    framework:gui-utils@
     #f
     mred^))
diff --git a/collects/tests/framework/debug.ss b/collects/tests/framework/debug.ss
index ca19a0a8..a2a606b1 100644
--- a/collects/tests/framework/debug.ss
+++ b/collects/tests/framework/debug.ss
@@ -1,4 +1,4 @@
-(module debug-printf mzscheme
+(module debug mzscheme
   (provide debug-printf debug-when)
 
   ;; all of the steps in the tcp connection
@@ -12,7 +12,7 @@
   (define schedule? #t)
 
   ;; of the sexpression transactions between mz and mred
-  (define messages? #f)
+  (define messages? #t)
 
   (define-syntax debug-printf
     (lambda (stx)
diff --git a/collects/tests/framework/load.ss b/collects/tests/framework/load.ss
index 302c70b5..fd623d64 100644
--- a/collects/tests/framework/load.ss
+++ b/collects/tests/framework/load.ss
@@ -7,7 +7,7 @@
     (test
      (string->symbol file)
      void?
-     `(parameterize ([current-namespace (make-namespace)])
+     `(parameterize ([current-namespace (make-namespace 'mred)])
 	(eval '(require (lib ,file "framework")))
 	(with-handlers ([(lambda (x) #t)
 			 (lambda (x)
diff --git a/collects/tests/framework/test-suite-utils.ss b/collects/tests/framework/test-suite-utils.ss
index be91f1fb..d814f80a 100644
--- a/collects/tests/framework/test-suite-utils.ss
+++ b/collects/tests/framework/test-suite-utils.ss
@@ -228,20 +228,19 @@
       (fluid-let ([test-name in-test-name])
 	(when (or (not only-these-tests)
 		  (memq test-name only-these-tests))
-	  (let ([failed
-		 (with-handlers ([(lambda (x) #t)
-				  (lambda (x)
-				    (if (exn? x)
-					(exn-message x)
-					x))])
-		   (let ([result
-			  (if (procedure? sexp/proc)
-			      (sexp/proc)
-			      (begin0 (send-sexp-to-mred sexp/proc)
-				      (send-sexp-to-mred ''check-for-errors)))])
-		     (not (passed? result))))])
+	  (let* ([result
+		  (with-handlers ([(lambda (x) #t)
+				   (lambda (x)
+				     (if (exn? x)
+					 (exn-message x)
+					 x))])
+		    (if (procedure? sexp/proc)
+			(sexp/proc)
+			(begin0 (send-sexp-to-mred sexp/proc)
+				(send-sexp-to-mred ''check-for-errors))))]
+		 [failed (not (passed? result))])
 	    (when failed
-	      (debug-printf schedule "FAILED ~a: ~a~n" failed test-name)
+	      (debug-printf schedule "FAILED ~a:~n  ~s~n" test-name result)
 	      (set! failed-tests (cons (cons section-name test-name) failed-tests))
 	      (case jump
 		[(section) (section-jump)]