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:
parent
5937bcbbf5
commit
7b0608ca42
|
@ -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
|
||||||
|
|
|
@ -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))
|
||||||
|
;; when got-status-update isn't 'finished-expansion, then
|
||||||
|
;; that means that expansion won't ever finish (due to
|
||||||
|
;; an error or an aborted job)
|
||||||
|
(when (equal? got-status-update 'finished-expansion)
|
||||||
(queue-callback
|
(queue-callback
|
||||||
(λ ()
|
(λ ()
|
||||||
(when (and (eq? us pending-thread)
|
(when (and (eq? us pending-thread)
|
||||||
pending-tell-the-tab-show-bkg-running)
|
pending-tell-the-tab-show-bkg-running)
|
||||||
(pending-tell-the-tab-show-bkg-running
|
(pending-tell-the-tab-show-bkg-running
|
||||||
'finished-expansion
|
'finished-expansion
|
||||||
sc-online-expansion-running))))))
|
sc-online-expansion-running)))))))
|
||||||
(define res (place-channel-get pc-out))
|
(define res (place-channel-get pc-out))
|
||||||
(queue-callback
|
(queue-callback
|
||||||
(λ ()
|
(λ ()
|
||||||
|
|
Loading…
Reference in New Issue
Block a user