fix a leak in DrRacket

It was leaking threads at about the rate of 2 per online expansion
that had a syntax error (or otherwise aborted without finishing
expansion)
This commit is contained in:
Robby Findler 2013-03-24 17:58:06 -05:00
parent 5937bcbbf5
commit 7b0608ca42
2 changed files with 15 additions and 8 deletions

View File

@ -171,7 +171,7 @@
(semaphore-wait io-sema)) (semaphore-wait io-sema))
(channel-put old-registry-chan (channel-put old-registry-chan
(namespace-module-registry (current-namespace))) (namespace-module-registry (current-namespace)))
(place-channel-put pc-status-expanding-place (void)) (place-channel-put pc-status-expanding-place 'finished-expansion)
(ep-log-info "expanding-place.rkt: 10 expanded") (ep-log-info "expanding-place.rkt: 10 expanded")
(define handler-results (define handler-results
(for/list ([handler (in-list handlers)]) (for/list ([handler (in-list handlers)])
@ -213,6 +213,8 @@
(handle-evt (handle-evt
abnormal-termination abnormal-termination
(λ (val) (λ (val)
(place-channel-put pc-status-expanding-place
'abnormal-termination)
(place-channel-put (place-channel-put
response-pc response-pc
(vector 'abnormal-termination (vector 'abnormal-termination
@ -232,6 +234,7 @@
(handle-evt (handle-evt
exn-chan exn-chan
(λ (exn+loaded-paths) (λ (exn+loaded-paths)
(place-channel-put pc-status-expanding-place 'exn-raised)
(define exn (list-ref exn+loaded-paths 0)) (define exn (list-ref exn+loaded-paths 0))
(place-channel-put (place-channel-put
response-pc response-pc

View File

@ -2016,13 +2016,17 @@
(define us (current-thread)) (define us (current-thread))
(thread (λ () (thread (λ ()
(define got-status-update (place-channel-get pc-status-drracket-place)) (define got-status-update (place-channel-get pc-status-drracket-place))
(queue-callback ;; when got-status-update isn't 'finished-expansion, then
(λ () ;; that means that expansion won't ever finish (due to
(when (and (eq? us pending-thread) ;; an error or an aborted job)
pending-tell-the-tab-show-bkg-running) (when (equal? got-status-update 'finished-expansion)
(pending-tell-the-tab-show-bkg-running (queue-callback
'finished-expansion (λ ()
sc-online-expansion-running)))))) (when (and (eq? us pending-thread)
pending-tell-the-tab-show-bkg-running)
(pending-tell-the-tab-show-bkg-running
'finished-expansion
sc-online-expansion-running)))))))
(define res (place-channel-get pc-out)) (define res (place-channel-get pc-out))
(queue-callback (queue-callback
(λ () (λ ()