From fed1e3dc3e2d7268c0297a0ce699d3deb2ba75c5 Mon Sep 17 00:00:00 2001
From: Robby Findler <robby@racket-lang.org>
Date: Thu, 7 Oct 2010 14:27:56 -0500
Subject: [PATCH] adjusted the way the teaching languages work so that
 signature violations in the REPL are tracked.

---
 collects/lang/htdp-langs.rkt           | 17 +++++++++++++++++
 collects/lang/run-teaching-program.rkt |  8 +++++++-
 2 files changed, 24 insertions(+), 1 deletion(-)

diff --git a/collects/lang/htdp-langs.rkt b/collects/lang/htdp-langs.rkt
index a5ba78d5ae..aeeadc00ed 100644
--- a/collects/lang/htdp-langs.rkt
+++ b/collects/lang/htdp-langs.rkt
@@ -19,6 +19,7 @@
          compiler/embed
          wxme/wxme
          setup/dirs
+         test-engine/racket-tests
          
          ;; this module is shared between the drscheme's namespace (so loaded here) 
          ;; and the user's namespace in the teaching languages
@@ -547,6 +548,22 @@
                                      (get-module)
                                      (htdp-lang-settings-teachpacks settings)
                                      (drscheme:rep:current-rep)))
+          
+          (define/override (front-end/interaction port settings)
+            (let ([t (super front-end/interaction port settings)]
+                  [done? #f])
+              (λ ()
+                (cond
+                  [done? eof]
+                  [else
+                   (let ([ans (t)])
+                     (cond
+                       [(eof-object? ans)
+                        (set! done? #t)
+                        #`(test)]
+                       [else
+                        ans]))]))))
+
 
           (define keywords #f)
           (define/augment (capability-value key)
diff --git a/collects/lang/run-teaching-program.rkt b/collects/lang/run-teaching-program.rkt
index c8b2d0e3e6..22b8e446ab 100644
--- a/collects/lang/run-teaching-program.rkt
+++ b/collects/lang/run-teaching-program.rkt
@@ -59,7 +59,13 @@
                             ,@(map (λ (x) `(require ,x)) teachpacks)
                             ,@body-exps
                             ,@(if enable-testing?
-                                  (if (null? body-exps) '() `((,#'test)))
+                                  (if (null? body-exps)
+                                      '() 
+                                      ;; this definition pulls the test~object binding from the user's namespace
+                                      ;; over to the one that is used in the REPL when module->namepsace
+                                      ;; grabs a hold of this module to make a namespace for the REPL
+                                      `(,#'(define test~object (namespace-variable-value 'test~object))
+                                        (,#'test)))
                                   '()))))
               rep)))]
         [(require)