diff --git a/code/fd-stream.lisp b/code/fd-stream.lisp index 566d6c88e77f98b9fd0c8613ab00fd1727cc78af..2dc7af2397a38123143f817980d678765cfd9826 100644 --- a/code/fd-stream.lisp +++ b/code/fd-stream.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/fd-stream.lisp,v 1.107 2010/07/03 13:39:20 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/fd-stream.lisp,v 1.108 2010/07/03 14:10:40 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -432,15 +432,25 @@ (setf (fd-stream-obuf-tail stream) tail))) (t ;; No flush-state function, so just output a replacement - ;; character. We hack the co-state to what we need for this - ;; to work. This should be ok because we're closing the - ;; file anyway. - (let ((state (fd-stream-co-state stream))) - (when (and state (car state)) + ;; character (or signal an error). We hack the co-state to + ;; what we need for this to work. This should be ok because + ;; we're closing the file anyway. + (let* ((state (fd-stream-co-state stream)) + (c (car state))) + (when (and state c) (setf (fd-stream-co-state stream) (cons nil (cdr state))) (funcall (ef-cout (fd-stream-external-format stream)) - stream (car state)))))) + stream + ;; Handle bare surrogates or use the + ;; replacement character. + (if (lisp::surrogatep c) + (if (fd-stream-char-to-octets-error stream) + (funcall (fd-stream-char-to-octets-error stream) + "Flushing bare surrogate #x~4,0X is illegal" + (char-code c)) + (code-char stream:+replacement-character-code+)) + c)))))) (values)))) ;;; FLUSH-OUTPUT-BUFFER -- internal