core: invoke-with-output-buffered: more robust implementation

This implementation of the function ensures, that the output is forced only
when the buffering state changes.

1 files changed, 11 insertions, 7 deletions

diff --git a/Core/drawing/medium.lisp b/Core/drawing/medium.lisp
index cfdaba99..f307c7bc 100644
--- a/Core/drawing/medium.lisp
+++ b/Core/drawing/medium.lisp
@@ -335,13 +335,17 @@
 
 (defmethod invoke-with-output-buffered
     ((medium basic-medium) continuation &optional (buffered-p t))
-  (unwind-protect
-       (letf (((medium-buffering-output-p medium) buffered-p))
-         (unless buffered-p
-           (medium-force-output medium))
-         (funcall continuation))
-    (unless (medium-buffering-output-p medium)
-      (medium-force-output medium))))
+  (let ((buffering-output-p (medium-buffering-output-p medium)))
+    ;; When the buffering state changes, then we ensure that all output is
+    ;; synchronized before and after invoking the continuation.
+    ;; MEDIUM-FINISH-OUTPUT may behave differently when buffering output.
+    (if (alexandria:xor buffered-p buffering-output-p)
+        (progn
+          (medium-finish-output medium)
+          (letf (((medium-buffering-output-p medium) buffered-p))
+            (funcall continuation)
+            (medium-finish-output medium)))
+        (funcall continuation))))
 
 ;;; Default method.
 (defmethod invoke-with-output-buffered