From 75c08a2c41dcb8a02f3f24ac340f968551b62bb4 Mon Sep 17 00:00:00 2001
From: Robby Findler <robby@racket-lang.org>
Date: Thu, 30 Apr 2015 09:01:46 -0500
Subject: [PATCH] remove problematic and unecessary syncronization

(cherry picked from commit 175e29a762acb1519e950defc1452fab2a58a0a9)
---
 gui-lib/framework/private/text.rkt |  4 +--
 gui-test/framework/tests/text.rkt  | 53 +++++++++++++++++++++++++++++-
 2 files changed, 53 insertions(+), 4 deletions(-)

diff --git a/gui-lib/framework/private/text.rkt b/gui-lib/framework/private/text.rkt
index 883bbf60..f99e7eb6 100644
--- a/gui-lib/framework/private/text.rkt
+++ b/gui-lib/framework/private/text.rkt
@@ -2674,9 +2674,7 @@
                      (split-queue converter q))
                    (cond
                      [flush-keep-trying?
-                      (define c (make-channel))
-                      (queue-insertion viable-bytes c)
-                      (channel-put c #f)
+                      (queue-insertion viable-bytes always-evt)
                       (loop next-remaining-queue)]
                      [else
                       (set! remaining-queue next-remaining-queue)
diff --git a/gui-test/framework/tests/text.rkt b/gui-test/framework/tests/text.rkt
index 33651486..0117c76a 100644
--- a/gui-test/framework/tests/text.rkt
+++ b/gui-test/framework/tests/text.rkt
@@ -465,4 +465,55 @@
               [op (send t get-out-port)])
          (display ,non-ascii-str op)
          (flush-output op)
-         (send t get-text 0 (send t last-position)))))))
+         (send t get-text 0 (send t last-position))))))
+
+
+  ;; This test sends a lot of flushes from a separate thread and,
+  ;; while doing that, sends a `clear-output-ports` from the
+  ;; eventspace main thread where the text was created. The goal
+  ;; is to make sure there is no deadlock for this interaction.
+  (test
+   'text:ports%.flush-and-clear-output-ports-interaction
+   (λ (x)
+     ;; we know we're going to get all 'a's, but some of
+     ;; the output could be discarded by `clear-output-ports`
+     (and (regexp-match #rx"^a*$" x)
+          (<= 100 (string-length x) 200)))
+   (λ ()
+     (queue-sexp-to-mred
+      `(let ()
+         (define es (make-eventspace))
+         (define-values (text port)
+           (let ()
+             (define c (make-channel))
+             (parameterize ([current-eventspace es])
+               (queue-callback
+                (λ ()
+                  (define t
+                    (new (text:ports-mixin
+                          (text:wide-snip-mixin
+                           text:basic%))))
+                  (channel-put c t)
+                  (channel-put c (send t get-out-port)))))
+             (values (channel-get c)
+                     (channel-get c))))
+         (define clear-output-go (make-semaphore 0))
+         (define clear-output-done (make-semaphore 0))
+         (void
+          (thread
+           (λ ()
+             (semaphore-wait clear-output-go)
+             (parameterize ([current-eventspace es])
+               (queue-callback
+                (λ ()
+                  (send text clear-output-ports)
+                  (semaphore-post clear-output-done)))))))
+         (for ([x (in-range 100)])
+           (display #\a port)
+           (flush-output port))
+         (semaphore-post clear-output-go)
+         (for ([x (in-range 100)])
+           (display #\a port)
+           (flush-output port))
+         (semaphore-wait clear-output-done)
+         (send text get-text))))))