From 0c3220f329489c342bbe8e3e5e22544d9c138e22 Mon Sep 17 00:00:00 2001 From: rtoy <rtoy> Date: Sat, 3 Jul 2010 13:45:01 +0000 Subject: [PATCH] Add flush-state method to flush out the UTF16 state. This allows us to signal errors on bare surrogates at the end of the output. --- .../external-formats/utf-16-be.lisp | 15 +++++++++++++-- .../external-formats/utf-16-le.lisp | 15 +++++++++++++-- pcl/simple-streams/external-formats/utf-16.lisp | 15 +++++++++++++-- 3 files changed, 39 insertions(+), 6 deletions(-) diff --git a/pcl/simple-streams/external-formats/utf-16-be.lisp b/pcl/simple-streams/external-formats/utf-16-be.lisp index a68ae5abf..a4150f26e 100644 --- a/pcl/simple-streams/external-formats/utf-16-be.lisp +++ b/pcl/simple-streams/external-formats/utf-16-be.lisp @@ -4,7 +4,7 @@ ;;; This code was written by Paul Foley and has been placed in the public ;;; domain. ;;; -(ext:file-comment "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/simple-streams/external-formats/utf-16-be.lisp,v 1.6 2010/07/02 23:13:11 rtoy Exp $") +(ext:file-comment "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/simple-streams/external-formats/utf-16-be.lisp,v 1.7 2010/07/03 13:45:01 rtoy Exp $") (in-package "STREAM") @@ -71,7 +71,18 @@ (output (logior ,c2 #xDC00)))) (t (output +replacement-character-code+))))) - nil + (flush-state (state output error c) + `(flet ((out (code) + (,output (ldb (byte 8 8) code)) + (,output (ldb (byte 8 0) code)))) + (let ((,c (car ,state))) + (,output (if (lisp::surrogatep ,c) + (if ,error + (funcall ,error + "Flushing bare surrogate #x~4,0X is illegal for UTF-16" + (char-code ,c)) + +replacement-character-code+) + ,c))))) (copy-state (state) ;; The state is either NIL or a codepoint, so nothing really ;; special is needed to copy it. diff --git a/pcl/simple-streams/external-formats/utf-16-le.lisp b/pcl/simple-streams/external-formats/utf-16-le.lisp index 4034ce532..365eea5ff 100644 --- a/pcl/simple-streams/external-formats/utf-16-le.lisp +++ b/pcl/simple-streams/external-formats/utf-16-le.lisp @@ -4,7 +4,7 @@ ;;; This code was written by Paul Foley and has been placed in the public ;;; domain. ;;; -(ext:file-comment "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/simple-streams/external-formats/utf-16-le.lisp,v 1.6 2010/07/02 23:13:11 rtoy Exp $") +(ext:file-comment "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/simple-streams/external-formats/utf-16-le.lisp,v 1.7 2010/07/03 13:45:01 rtoy Exp $") (in-package "STREAM") @@ -72,7 +72,18 @@ (output (logior ,c2 #xDC00)))) (t (output +replacement-character-code+))))) - nil + (flush-state (state output error c) + `(flet ((out (code) + (,output (ldb (byte 8 0) code)) + (,output (ldb (byte 8 8) code)))) + (let ((,c (car ,state))) + (,output (if (lisp::surrogatep ,c) + (if ,error + (funcall ,error + "Flushing bare surrogate #x~4,0X is illegal for UTF-16" + (char-code ,c)) + +replacement-character-code+) + ,c))))) (copy-state (state) ;; The state is either NIL or a codepoint, so nothing really ;; special is needed. diff --git a/pcl/simple-streams/external-formats/utf-16.lisp b/pcl/simple-streams/external-formats/utf-16.lisp index e64e8f5fd..04e268687 100644 --- a/pcl/simple-streams/external-formats/utf-16.lisp +++ b/pcl/simple-streams/external-formats/utf-16.lisp @@ -1,7 +1,7 @@ ;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Package: STREAM -*- ;;; ;;; ********************************************************************** -(ext:file-comment "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/simple-streams/external-formats/utf-16.lisp,v 1.8 2010/07/02 23:13:11 rtoy Exp $") +(ext:file-comment "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/simple-streams/external-formats/utf-16.lisp,v 1.9 2010/07/03 13:45:01 rtoy Exp $") (in-package "STREAM") @@ -112,7 +112,18 @@ (output (logior ,c2 #xDC00)))) (t (output +replacement-character-code+))))) - nil + (flush-state (state output error c) + `(flet ((out (code) + (,output (ldb (byte 8 8) code)) + (,output (ldb (byte 8 0) code)))) + (let ((,c (car ,state))) + (out (if (lisp::surrogatep ,c) + (if ,error + (funcall ,error + "Flushing bare surrogate #x~4,0X is illegal for UTF-16" + (char-code ,c)) + +replacement-character-code+) + ,c))))) (copy-state (state) ;; The state is list. Copy it `(copy-list ,state))) -- GitLab