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

fixed race condition

Browse Source 
svn: r10602
This commit is contained in:
Robby Findler 2008-07-04 19:33:14 +00:00
parent 489f1e732e
commit 6117dc413f
1 changed files with 25 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

40
collects/drscheme/private/module-language.ss
View File

@ -19,7 +19,8 @@
(import [prefix drscheme:language-configuration: drscheme:language-configuration/internal^] (import [prefix drscheme:language-configuration: drscheme:language-configuration/internal^]
[prefix drscheme:language: drscheme:language^] [prefix drscheme:language: drscheme:language^]
[prefix drscheme:unit: drscheme:unit^] [prefix drscheme:unit: drscheme:unit^]
[prefix drscheme:rep: drscheme:rep^]) [prefix drscheme:rep: drscheme:rep^]
[prefix drscheme:init: drscheme:init^])
(export drscheme:module-language^) (export drscheme:module-language^)
(define module-language<%> (define module-language<%>
@ -245,20 +246,29 @@
(define hopeless-repl (make-thread-cell #t)) (define hopeless-repl (make-thread-cell #t))
(define (raise-hopeless-exception exn [prefix #f]) (define (raise-hopeless-exception exn [prefix #f])
(define rep (drscheme:rep:current-rep)) (define rep (drscheme:rep:current-rep))
;; MINOR HACK: since this is a value that is used by the drscheme thread,
;; Robby says it's better to set it while in that thread. This requires ;; if we don't have the drscheme rep, then we just raise
;; adding `drscheme:init^' to the imports to get ;; the exception as normal. (I don't think this can happen...?)
;; `drscheme:init:system-eventspace', or make `queue-system-callback/sync' (unless rep
;; into a public method (accessible here). (raise exn))
(if (not rep)
(raise exn) (let ([send-over
(begin (λ (t)
(send rep set-show-no-user-evaluation-message? #f) (let ([s (make-semaphore 0)])
(when prefix (parameterize ([current-eventspace drscheme:init:system-eventspace])
(fprintf (current-error-port) "Module Language: ~a\n" prefix)) (queue-callback
((error-display-handler) (exn-message exn) exn) (λ ()
(send rep insert-warning "\n[Interactions disabled]") (t)
(custodian-shutdown-all (send rep get-user-custodian))))) (semaphore-post s))))
(semaphore-wait s)))])
(send-over (λ () (send rep set-show-no-user-evaluation-message? #f)))
(when prefix
(fprintf (current-error-port) "Module Language: ~a\n" prefix))
((error-display-handler) (exn-message exn) exn)
(send-over
(λ () (send rep insert-warning "\nInteractions disabled.")))
(custodian-shutdown-all (send rep get-user-custodian))))
(define (raise-hopeless-syntax-error . error-args) (define (raise-hopeless-syntax-error . error-args)
(with-handlers ([exn? raise-hopeless-exception]) (with-handlers ([exn? raise-hopeless-exception])
(apply raise-syntax-error '|Module Language| (apply raise-syntax-error '|Module Language|