make an eventspace thread survive a break exception

When an eventspace is created, its thread implicitly calls
`yield'. It now effectively loops with `yield' and while
catching continuation aborts.

Closes PR 12566

collects/mred/private/wx/common/queue.rkt

@@ -383,17 +383,30 @@
 (define make-new-eventspace
   (let ([make-eventspace
          (lambda ()
-           (letrec ([pause (make-semaphore)]
+           (define pause (make-semaphore))
-                    [es
+           (define break-paramz (current-break-parameterization))
+           (define es
              (make-eventspace*
+              (parameterize-break 
+               #f ; disable breaks until we're in the yield loop
                (thread
                 (lambda ()
-                         (sync pause)
+                  (sync pause) ; wait until `es' has a value
                   (thread-cell-set! handler-thread-of es)
                   (current-eventspace es)
-                         (yield (make-semaphore)))))])
+                  (let loop ()
-             (semaphore-post pause)
+                    (call-with-continuation-prompt
-             es))])
+                     (lambda ()
+                       ;; re-enable breaks (if they are supposed to be enabled):
+                       (call-with-break-parameterization
+                        break-paramz
+                        (lambda () 
+                          ;; yield; any abort (including a break exception)
+                          ;; will get caught and the loop will yield again
+                          (yield (make-semaphore))))))
+                    (loop)))))))
+           (semaphore-post pause) ; `es' has a value
+           es)])
     make-eventspace))
 
 (define (queue-event eventspace thunk [level 'med])

collects/tests/gracket/paramz.rktl

@@ -105,4 +105,23 @@
 (try-use-es (lambda () (queue-callback void)))
 (try-use-es (lambda () (send tmr start 100 #t)))
 
+;; ----------------------------------------
+;;  Check that breaking an eventspace thread doesn't kill it:
+
+(let ()
+  (define evtsp (make-eventspace))
+  (define evtth (eventspace-handler-thread evtsp))
+  
+  (sleep 0.1)
+  (break-thread evtth)
+
+  (define done (make-semaphore))
+  (parameterize ((current-eventspace evtsp))
+    (queue-callback (lambda () (semaphore-post done))))
+
+  (unless (sync/timeout 3 done)
+    (error "broken thread is really broken")))
+
+;; ----------------------------------------
+
 (report-errs)