CMUCL commit: src/pcl/simple-streams/external-formats (3 files)

[Raymond Toy]

    Date: Saturday, July 3, 2010 @ 09:45:01
  Author: rtoy
    Path: /project/cmucl/cvsroot/src/pcl/simple-streams/external-formats

Modified: utf-16-be.lisp utf-16-le.lisp utf-16.lisp

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.


----------------+
 utf-16-be.lisp |   15 +++++++++++++--
 utf-16-le.lisp |   15 +++++++++++++--
 utf-16.lisp    |   15 +++++++++++++--
 3 files changed, 39 insertions(+), 6 deletions(-)


Index: src/pcl/simple-streams/external-formats/utf-16-be.lisp
diff -u src/pcl/simple-streams/external-formats/utf-16-be.lisp:1.6 src/pcl/simple-streams/external-formats/utf-16-be.lisp:1.7
--- src/pcl/simple-streams/external-formats/utf-16-be.lisp:1.6	Fri Jul  2 19:13:11 2010
+++ src/pcl/simple-streams/external-formats/utf-16-be.lisp	Sat Jul  3 09:45:01 2010
@@ -4,7 +4,7 @@
 ;;; This code was written by Paul Foley and has been placed in the public
 ;;; domain.
 ;;;
-(ext:file-comment "$Header: /project/cmucl/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: /project/cmucl/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.
Index: src/pcl/simple-streams/external-formats/utf-16-le.lisp
diff -u src/pcl/simple-streams/external-formats/utf-16-le.lisp:1.6 src/pcl/simple-streams/external-formats/utf-16-le.lisp:1.7
--- src/pcl/simple-streams/external-formats/utf-16-le.lisp:1.6	Fri Jul  2 19:13:11 2010
+++ src/pcl/simple-streams/external-formats/utf-16-le.lisp	Sat Jul  3 09:45:01 2010
@@ -4,7 +4,7 @@
 ;;; This code was written by Paul Foley and has been placed in the public
 ;;; domain.
 ;;;
-(ext:file-comment "$Header: /project/cmucl/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: /project/cmucl/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.
Index: src/pcl/simple-streams/external-formats/utf-16.lisp
diff -u src/pcl/simple-streams/external-formats/utf-16.lisp:1.8 src/pcl/simple-streams/external-formats/utf-16.lisp:1.9
--- src/pcl/simple-streams/external-formats/utf-16.lisp:1.8	Fri Jul  2 19:13:11 2010
+++ src/pcl/simple-streams/external-formats/utf-16.lisp	Sat Jul  3 09:45:01 2010
@@ -1,7 +1,7 @@
 ;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Package: STREAM -*-
 ;;;
 ;;; **********************************************************************
-(ext:file-comment "$Header: /project/cmucl/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: /project/cmucl/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)))