suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

avoid eval-compile-time-part-of-top-level when in the module language

Browse Source 
Thanks to Ryan for spotting this call!
  Closes PR 11908
This commit is contained in:
Robby Findler 2011-05-09 21:16:44 -05:00
parent edeab3a413
commit c5f8add9ea
2 changed files with 43 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
collects/drracket/private/syncheck/gui.rkt
View File

@ -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=

35
collects/tests/drracket/syncheck-eval-compile-time.rkt Normal file
View File

@ -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)