From c8a1ec8c9c477be5ac62c27dfb36c4e48e86b1e1 Mon Sep 17 00:00:00 2001
From: Robby Findler <robby@racket-lang.org>
Date: Tue, 15 Jan 2013 08:59:52 -0600
Subject: [PATCH] fix bug in online check syntax's save file notification

Before this commit, the files that are loaded during expansion
were discarded when an error during expansion occurs. This commit
saves them: unless the program is something like

  (begin-for-syntax (kill-thread (current-thread)))

the handling that deals with that kind of situation (as opposed
to just an exception being raised) doesn't try to save them

Do not merge to 5.3.2: this bug isn't serious and the new code
is not as well tested as the old
---
 collects/drracket/private/expanding-place.rkt | 19 ++++++++++++-------
 collects/drracket/private/module-language.rkt | 13 ++++---------
 2 files changed, 16 insertions(+), 16 deletions(-)

diff --git a/collects/drracket/private/expanding-place.rkt b/collects/drracket/private/expanding-place.rkt
index 77305b33a4..7373f9e5f4 100644
--- a/collects/drracket/private/expanding-place.rkt
+++ b/collects/drracket/private/expanding-place.rkt
@@ -109,6 +109,7 @@
          (ep-log-info "expanding-place.rkt: 05 installing security guard")
          (install-security-guard) ;; must come after the call to set-module-language-parameters
          (ep-log-info "expanding-place.rkt: 06 setting uncaught-exception-handler")
+         (define loaded-paths '())
          (uncaught-exception-handler
           (λ (exn)
             (parameterize ([current-custodian orig-cust])
@@ -116,7 +117,7 @@
                (λ ()
                  (stop-watching-abnormal-termination)
                  (semaphore-post sema)
-                 (channel-put exn-chan exn))))
+                 (channel-put exn-chan (list exn loaded-paths)))))
             (semaphore-wait sema)
             ((error-escape-handler))))
          (ep-log-info "expanding-place.rkt: 07 starting read-syntax")
@@ -138,7 +139,6 @@
            (when log-io?
              (thread (λ () (catch-and-log in io-sema))))
            (define original-path (make-parameter #f))
-           (define loaded-paths '())
            (define expanded 
              (parameterize ([current-output-port out]
                             [current-error-port out]
@@ -210,16 +210,20 @@
                   ;; note: this message is actually ignored: a string 
                   ;; constant is used back in the drracket place
                   "Expansion thread terminated unexpectedly"
+                  '()
+                  
+                  ;; give up on dep paths in this case:
                   '()))))
       (handle-evt
        result-chan
-       (λ (val+loaded-files)
+       (λ (val+loaded-paths)
          (place-channel-put response-pc (vector 'handler-results 
-                                                (list-ref val+loaded-files 0)
-                                                (list-ref val+loaded-files 1)))))
+                                                (list-ref val+loaded-paths 0)
+                                                (list-ref val+loaded-paths 1)))))
       (handle-evt
        exn-chan
-       (λ (exn)
+       (λ (exn+loaded-paths)
+         (define exn (list-ref exn+loaded-paths 0))
          (place-channel-put 
           response-pc
           (vector 
@@ -249,7 +253,8 @@
                           (srcloc-span srcloc)))
                 <
                 #:key (λ (x) (vector-ref x 0)))
-               '()))))))))
+               '())
+           (list-ref exn+loaded-paths 1))))))))
   
   (define (stop-watching-abnormal-termination) 
     (channel-put normal-termination #t))
diff --git a/collects/drracket/private/module-language.rkt b/collects/drracket/private/module-language.rkt
index 5268861570..b56393f7f7 100644
--- a/collects/drracket/private/module-language.rkt
+++ b/collects/drracket/private/module-language.rkt
@@ -1937,7 +1937,7 @@
                 val))))
          
          (send running-tab set-oc-status (clean #f #f '()))
-         (send running-tab set-dep-paths (vector-ref res 2))]
+         (send running-tab set-dep-paths (list->set (vector-ref res 2)))]
         [else
          (line-of-interest)
          (send running-tab set-oc-status
@@ -1945,7 +1945,8 @@
                       (if (eq? (vector-ref res 0) 'abnormal-termination)
                           sc-abnormal-termination
                           (vector-ref res 1))
-                      (vector-ref res 2)))])
+                      (vector-ref res 2)))
+         (send running-tab set-dep-paths (list->set (vector-ref res 3)))])
       (oc-maybe-start-something)))
   
   (define/oc-log (oc-status-message sym str)
@@ -2018,19 +2019,13 @@
                                'finished-expansion
                                sc-online-expansion-running))))))
                (define res (place-channel-get pc-out))
-               (define res/set 
-                 (if (eq? (vector-ref res 0) 'handler-results)
-                     (vector (vector-ref res 0)
-                             (vector-ref res 1)
-                             (list->set (vector-ref res 2)))
-                     res))
                (queue-callback
                 (λ ()
                   (when (eq? us pending-thread)
                     (set-pending-thread #f #f))
                   (when (getenv "PLTDRPLACEPRINT")
                     (printf "PLTDRPLACEPRINT: got results back from the place\n"))
-                  (show-results res/set)))))))
+                  (show-results res)))))))
   
   (define (stop-place-running)
     (when expanding-place