From a385788971734b157ae55ddd19c6d50aa4563644 Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Tue, 27 Apr 2021 09:23:32 -0600
Subject: [PATCH] cs: make `flush-output` error if port is closed

Closes #3803
---
 pkgs/racket-test-core/tests/racket/port.rktl |  3 +-
 racket/src/cs/schemified/io.scm              | 56 ++++++++++++--------
 racket/src/io/port/flush-output.rkt          | 13 +++--
 3 files changed, 44 insertions(+), 28 deletions(-)

diff --git a/pkgs/racket-test-core/tests/racket/port.rktl b/pkgs/racket-test-core/tests/racket/port.rktl
index ee7bbdf920..8c3cfb5373 100644
--- a/pkgs/racket-test-core/tests/racket/port.rktl
+++ b/pkgs/racket-test-core/tests/racket/port.rktl
@@ -963,7 +963,8 @@
   (check (lambda (p) (write-byte 10 p)))
   (check (lambda (p) (write-bytes #"hello" p)))
   (check (lambda (p) (write-char #\x p)))
-  (check (lambda (p) (write-string "hello" p))))
+  (check (lambda (p) (write-string "hello" p)))
+  (check flush-output))
 
 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; port-closed events
diff --git a/racket/src/cs/schemified/io.scm b/racket/src/cs/schemified/io.scm
index 7918340c7f..96e3883afe 100644
--- a/racket/src/cs/schemified/io.scm
+++ b/racket/src/cs/schemified/io.scm
@@ -11838,10 +11838,13 @@
                                     loop
                                     (lambda ()
                                       (begin
-                                        (let ((r_0
-                                               (begin
-                                                 (unsafe-start-atomic)
-                                                 (begin0
+                                        (begin
+                                          (unsafe-start-atomic)
+                                          (begin
+                                            (check-not-closed
+                                             'flush-output
+                                             out_0)
+                                            (let ((r_0
                                                    (|#%app|
                                                     write-out_0
                                                     out_0
@@ -11850,26 +11853,33 @@
                                                     0
                                                     #f
                                                     #f
-                                                    #f)
-                                                   (unsafe-end-atomic)))))
-                                          (letrec*
-                                           ((r-loop_0
-                                             (|#%name|
-                                              r-loop
-                                              (lambda (r_1)
-                                                (begin
-                                                  (if (eq? r_1 0)
-                                                    (void)
-                                                    (if (not r_1)
-                                                      (loop_0)
-                                                      (if (evt? r_1)
-                                                        (r-loop_0 (sync r_1))
-                                                        (error
-                                                         'flush-output
-                                                         "weird result")))))))))
-                                           (r-loop_0 r_0))))))))
+                                                    #f)))
+                                              (begin
+                                                (unsafe-end-atomic)
+                                                (letrec*
+                                                 ((r-loop_0
+                                                   (|#%name|
+                                                    r-loop
+                                                    (lambda (r_1)
+                                                      (begin
+                                                        (if (eq? r_1 0)
+                                                          (void)
+                                                          (if (not r_1)
+                                                            (loop_0)
+                                                            (if (evt? r_1)
+                                                              (r-loop_0
+                                                               (sync r_1))
+                                                              (error
+                                                               'flush-output
+                                                               "weird result")))))))))
+                                                 (r-loop_0 r_0)))))))))))
                                  (loop_0))
-                                (wo-loop_0 write-out_0)))))))))
+                                (begin
+                                  (unsafe-start-atomic)
+                                  (begin0
+                                    (check-not-closed 'flush-output out_0)
+                                    (unsafe-end-atomic))
+                                  (wo-loop_0 write-out_0))))))))))
                    (wo-loop_0 p_0)))))))))
     (|#%name|
      flush-output
diff --git a/racket/src/io/port/flush-output.rkt b/racket/src/io/port/flush-output.rkt
index 4eb33ed237..a5df7c8a1c 100644
--- a/racket/src/io/port/flush-output.rkt
+++ b/racket/src/io/port/flush-output.rkt
@@ -5,7 +5,8 @@
          "parameter.rkt"
          "port.rkt"
          "output-port.rkt"
-         "pipe.rkt")
+         "pipe.rkt"
+         "check.rkt")
 
 (provide flush-output
          maybe-flush-stdout)
@@ -18,15 +19,19 @@
     (cond
       [(procedure? write-out)
        (let loop ()
-         (define r (atomically
-                    (write-out out #"" 0 0 #f #f #f)))
+         (start-atomic)
+         (check-not-closed who out)
+         (define r (write-out out #"" 0 0 #f #f #f))
+         (end-atomic)
          (let r-loop ([r r])
            (cond
              [(eq? r 0) (void)]
              [(not r) (loop)]
              [(evt? r) (r-loop (sync r))]
              [else (error 'flush-output "weird result")])))]
-      [else (wo-loop write-out)])))
+      [else
+       (atomically (check-not-closed who out))
+       (wo-loop write-out)])))
 
 ;; ----------------------------------------