From c5f8add9ea5e430902bb502d615c7611790e3e99 Mon Sep 17 00:00:00 2001
From: Robby Findler <robby@racket-lang.org>
Date: Mon, 9 May 2011 21:16:44 -0500
Subject: [PATCH] avoid eval-compile-time-part-of-top-level when in the module
 language   Thanks to Ryan for spotting this call!   Closes PR 11908

---
 collects/drracket/private/syncheck/gui.rkt    | 13 ++++---
 .../drracket/syncheck-eval-compile-time.rkt   | 35 +++++++++++++++++++
 2 files changed, 43 insertions(+), 5 deletions(-)
 create mode 100644 collects/tests/drracket/syncheck-eval-compile-time.rkt

diff --git a/collects/drracket/private/syncheck/gui.rkt b/collects/drracket/private/syncheck/gui.rkt
index 0539652b6a..6010e49c60 100644
--- a/collects/drracket/private/syncheck/gui.rkt
+++ b/collects/drracket/private/syncheck/gui.rkt
@@ -1329,6 +1329,10 @@ If the namespace does not, they are colored the unbound color.
                                 (define/override (get-port-name)
                                   (send definitions-text get-port-name))
                                 (super-new))))
+                       (define settings (send definitions-text get-next-settings))
+                       (define module-language?
+                         (is-a? (drracket:language-configuration:language-settings-language settings)
+                                       drracket:module-language:module-language<%>))
                        (send definitions-text copy-self-to definitions-text-copy)
                        (with-lock/edit-sequence
                         definitions-text-copy
@@ -1336,13 +1340,11 @@ If the namespace does not, they are colored the unbound color.
                           (send the-tab clear-annotations)
                           (send the-tab reset-offer-kill)
                           (send (send the-tab get-defs) syncheck:init-arrows)
-                          (define settings (send definitions-text get-next-settings))
                           (drracket:eval:expand-program
                            #:gui-modules? #f
                            (drracket:language:make-text/pos definitions-text-copy 0 (send definitions-text-copy last-position))
                            settings
-                           (not (is-a? (drracket:language-configuration:language-settings-language settings)
-                                       drracket:module-language:module-language<%>))
+                           (not module-language?)
                            init-proc
                            kill-termination
                            (λ (sexp loop) ; =user=
@@ -1364,8 +1366,9 @@ If the namespace does not, they are colored the unbound color.
                                      (custodian-shutdown-all user-custodian))))]
                                [else
                                 (open-status-line 'drracket:check-syntax:status)
-                                (update-status-line 'drracket:check-syntax:status status-eval-compile-time)
-                                (eval-compile-time-part-of-top-level sexp)
+                                (unless module-language?
+                                  (update-status-line 'drracket:check-syntax:status status-eval-compile-time)
+                                  (eval-compile-time-part-of-top-level sexp))
                                 (parameterize ([current-eventspace drs-eventspace])
                                   (queue-callback
                                    (λ () ; =drs=
diff --git a/collects/tests/drracket/syncheck-eval-compile-time.rkt b/collects/tests/drracket/syncheck-eval-compile-time.rkt
new file mode 100644
index 0000000000..fd4fba8ef1
--- /dev/null
+++ b/collects/tests/drracket/syncheck-eval-compile-time.rkt
@@ -0,0 +1,35 @@
+#lang racket/base
+
+(require "drracket-test-util.rkt"
+         racket/class
+         framework)
+
+(define (main)
+  (fire-up-drscheme-and-run-tests
+   (λ ()
+     (let ([drs (wait-for-drscheme-frame)])
+       (set-module-language!)
+       (do-execute drs)
+       (queue-callback/res (λ () (handler:edit-file (collection-file-path "map.rkt" "racket" "private"))))
+       
+       (preferences:set 'framework:coloring-active #f)
+       (click-check-syntax-and-check-errors drs "syncheck-eval-compile-time.rkt")))))
+
+
+;; copied from syncheck-test.rkt ....
+(define (click-check-syntax-and-check-errors drs test)
+  (click-check-syntax-button drs)
+  (wait-for-computation drs)
+  (when (queue-callback/res (λ () (send (send drs get-definitions-text) in-edit-sequence?)))
+    (error 'syncheck-test.rkt "still in edit sequence for ~s" test))
+  
+  (let ([err (queue-callback/res (λ () (send drs syncheck:get-error-report-contents)))]) 
+    (when err
+      (fprintf (current-error-port)
+               "FAILED ~s\n   error report window is visible:\n   ~a\n"
+               test
+               err))))
+(define (click-check-syntax-button drs)
+  (test:run-one (lambda () (send (send drs syncheck:get-button) command))))
+
+(main)
\ No newline at end of file