From 03f299b6524698d8a3a898f1b7db794374a222d3 Mon Sep 17 00:00:00 2001
From: Kathy Gray <kathryn.gray@cl.cam.ac.uk>
Date: Wed, 9 Apr 2008 11:00:12 +0000
Subject: [PATCH] More decoupling

svn: r9218
---
 collects/lang/htdp-langs.ss          |  3 ++-
 collects/test-engine/scheme-gui.scm  |  5 +++--
 collects/test-engine/scheme-tests.ss | 25 ++++++++++++-------------
 3 files changed, 17 insertions(+), 16 deletions(-)

diff --git a/collects/lang/htdp-langs.ss b/collects/lang/htdp-langs.ss
index 593b957645..7e8f58e57d 100644
--- a/collects/lang/htdp-langs.ss
+++ b/collects/lang/htdp-langs.ss
@@ -39,6 +39,7 @@
            stepper/private/shared
            
            (lib "scheme-gui.scm" "test-engine")
+	   (lib "test-display.scm" "test-engine")
            )
   
   
@@ -173,7 +174,7 @@
                  (read-accept-dot (get-read-accept-dot))
                  (namespace-attach-module drs-namespace scheme-test-module-name)
                  (namespace-require scheme-test-module-name)
-                 (scheme-test-data (list (drscheme:rep:current-rep) drs-eventspace))
+                 (scheme-test-data (list (drscheme:rep:current-rep) drs-eventspace test-display%))
                  )))
             (super on-execute settings run-in-user-thread))
           
diff --git a/collects/test-engine/scheme-gui.scm b/collects/test-engine/scheme-gui.scm
index e36811ac34..789e2e5357 100644
--- a/collects/test-engine/scheme-gui.scm
+++ b/collects/test-engine/scheme-gui.scm
@@ -3,7 +3,8 @@
 (require scheme/class
          "test-engine.scm")
 
-(define scheme-test-data (make-parameter (list #f #f))) 
+(define scheme-test-data (make-parameter (list #f #f #f)))
+(define scheme-test-format (make-parameter (lambda (v) (format "~a" v))))
 
 (define scheme-test%
   (class* test-engine% ()
@@ -28,4 +29,4 @@
       (test)
       (inner (void) run-test test))))
 
-(provide scheme-test% scheme-test-data)
+(provide scheme-test% scheme-test-data scheme-test-format)
diff --git a/collects/test-engine/scheme-tests.ss b/collects/test-engine/scheme-tests.ss
index ae9bc2eed2..4e6c945df2 100644
--- a/collects/test-engine/scheme-tests.ss
+++ b/collects/test-engine/scheme-tests.ss
@@ -1,10 +1,10 @@
 #lang mzscheme
 
 (require lang/private/teachprims
-         mred
-         framework
-         mzlib/pretty
-         mzlib/pconvert
+         #;mred
+         #;framework
+         #;mzlib/pretty
+         #;mzlib/pconvert
          mzlib/class
          "scheme-gui.scm")
 
@@ -47,8 +47,7 @@
                                                    (current-namespace))])
           (and test-info
                (let ([display-data (scheme-test-data)])
-                 (send test-info refine-display-class 
-                       (dynamic-require '(lib "test-display.scm" "test-engine") 'test-display%))
+                 (send test-info refine-display-class (caddr display-data))
                  (send test-info setup-display
                        (car display-data) (cadr display-data))
                  (send test-info summarize-results (current-output-port)))))
@@ -250,19 +249,19 @@
   (cond
     [(unexpected-error? fail)
      (list "check encountered the following error instead of the expected value, "
-           (format-value (unexpected-error-expected fail))
+           ((scheme-test-format) (unexpected-error-expected fail))
            (format ". ~n   :: ~a~n" (unexpected-error-message fail)))]
     [(unequal? fail)
      (list "Actual value "
-           (format-value (unequal-test fail))
+           ((scheme-test-format) (unequal-test fail))
            " differs from "
-           (format-value (unequal-actual fail))
+           ((scheme-test-format) (unequal-actual fail))
            ", the expected value.\n")]
     [(outofrange? fail)
      (list "Actual value "
-           (format-value (outofrange-test fail))
+           ((scheme-test-format) (outofrange-test fail))
            (format " is not within ~v of expected value " (outofrange-range fail))
-           (format-value (outofrange-actual fail))
+           ((scheme-test-format) (outofrange-actual fail))
            ".\n")]
     [(incorrect-error? fail)
      (list (format "check-error encountered the following error instead of the expected ~a~n   :: ~a ~n"
@@ -270,10 +269,10 @@
                    (incorrect-error-message fail)))]
     [(expected-error? fail)
      (list "check-error expected the following error, but instead received the value "
-           (format-value (expected-error-value fail))
+           ((scheme-test-format) (expected-error-value fail))
            (format ".~n ~a~n" (expected-error-message fail)))]))
 
-(define (format-value value)
+#;(define (format-value value)
   (cond
     [(is-a? value snip%) value]
     [(or (pair? value) (struct? value))