From 7b0608ca42555e7da2123fc54eccb287034d89f3 Mon Sep 17 00:00:00 2001
From: Robby Findler <robby@racket-lang.org>
Date: Sun, 24 Mar 2013 17:58:06 -0500
Subject: [PATCH] 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)
---
 collects/drracket/private/expanding-place.rkt |  5 ++++-
 collects/drracket/private/module-language.rkt | 18 +++++++++++-------
 2 files changed, 15 insertions(+), 8 deletions(-)

diff --git a/collects/drracket/private/expanding-place.rkt b/collects/drracket/private/expanding-place.rkt
index fda534a214..527d10228e 100644
--- a/collects/drracket/private/expanding-place.rkt
+++ b/collects/drracket/private/expanding-place.rkt
@@ -171,7 +171,7 @@
            (semaphore-wait io-sema))
          (channel-put old-registry-chan 
                       (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")
          (define handler-results
            (for/list ([handler (in-list handlers)])
@@ -213,6 +213,8 @@
       (handle-evt
        abnormal-termination
        (λ (val) 
+         (place-channel-put pc-status-expanding-place
+                            'abnormal-termination)
          (place-channel-put 
           response-pc
           (vector 'abnormal-termination 
@@ -232,6 +234,7 @@
       (handle-evt
        exn-chan
        (λ (exn+loaded-paths)
+         (place-channel-put pc-status-expanding-place 'exn-raised)
          (define exn (list-ref exn+loaded-paths 0))
          (place-channel-put 
           response-pc
diff --git a/collects/drracket/private/module-language.rkt b/collects/drracket/private/module-language.rkt
index d9cab2e77c..522c676fa9 100644
--- a/collects/drracket/private/module-language.rkt
+++ b/collects/drracket/private/module-language.rkt
@@ -2016,13 +2016,17 @@
                (define us (current-thread))
                (thread (λ () 
                          (define got-status-update (place-channel-get pc-status-drracket-place))
-                         (queue-callback
-                          (λ ()
-                            (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))))))
+                         ;; 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
+                            (λ ()
+                              (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))
                (queue-callback
                 (λ ()