Ticket #652: stderr-flush-2.diff

l1-processes.lisp

@@ -641 +641 @@
       ;; We may have abruptly terminated a thread
       ;; which owned the output lock on *STDOUT*.
       ;; Don't block waiting on that lock if so.
-      (let* ((s *stdout*)
-             (lock (ioblock-outbuf-lock (basic-stream-ioblock s)))
-             (locked (make-lock-acquisition)))
-        (declare (dynamic-extent locked))
-        (when (or (null lock) (%try-recursive-lock-object lock locked))
-          (unwind-protect
-               (progn
-                 (fresh-line s)
-                 (finish-output s)))
-          (when (lock-acquisition.status locked) (release-lock lock)))))
+      (flet ((flush-stream (s)
+               (let ((lock (ioblock-outbuf-lock (basic-stream-ioblock s)))
+                     (locked (make-lock-acquisition)))
+                 (declare (dynamic-extent locked))
+                 (when (or (null lock) (%try-recursive-lock-object lock locked))
+                   (unwind-protect
+                        (progn
+                          (fresh-line s)
+                          (finish-output s))
+                     (when (lock-acquisition.status locked)
+                       (release-lock lock)))))))
+        (flush-stream *stdout*)
+        (flush-stream *stderr*)))
     (%set-toplevel thunk)
     (toplevel)))