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

[Raymond Toy]

    Date: Thursday, August 12, 2010 @ 21:35:25
  Author: rtoy
    Path: /project/cmucl/cvsroot/src/pcl/simple-streams/external-formats

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

utf-16-be.lisp:
o Fix typo.  There is no WD variable; it should be the constant 2.
o In FLUSH-STATE, only flush something if the state has something to
  be flushed.

utf-16-le.lisp:
o In FLUSH-STATE, only flush something if the state has something to
  be flushed.


----------------+
 utf-16-be.lisp |   21 +++++++++++----------
 utf-16-le.lisp |   17 +++++++++--------
 2 files changed, 20 insertions(+), 18 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.10 src/pcl/simple-streams/external-formats/utf-16-be.lisp:1.11
--- src/pcl/simple-streams/external-formats/utf-16-be.lisp:1.10	Mon Jul 12 10:42:11 2010
+++ src/pcl/simple-streams/external-formats/utf-16-be.lisp	Thu Aug 12 21:35:25 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.10 2010-07-12 14:42:11 rtoy Exp $")
+(ext:file-comment "$Header: /project/cmucl/cvsroot/src/pcl/simple-streams/external-formats/utf-16-be.lisp,v 1.11 2010-08-13 01:35:25 rtoy Exp $")
 
 (in-package "STREAM")
 (intl:textdomain "cmucl")
@@ -55,13 +55,13 @@
 		    (setq ,code (+ (ash (- ,code #xD800) 10) ,next #x2400))
 		    (setf ,code
 			  (if ,error
-			      (funcall ,error "High surrogate followed by #x~4,'0X instead of low surrogate" ,next ,wd)
+			      (funcall ,error "High surrogate followed by #x~4,'0X instead of low surrogate" ,next 2)
 			      +replacement-character-code+)))))
 	     ((= ,code #xFFFE)
 	      ;; Replace with REPLACEMENT CHARACTER.  
 	      (setf ,code
 		    (if ,error
-			(funcall ,error "BOM is not valid within a UTF-16 stream" ,code ,wd)
+			(funcall ,error "BOM is not valid within a UTF-16 stream" ,code 2)
 			+replacement-character-code+)))
 	     (t (setf ,state nil)))
        (values ,code 2)))
@@ -84,13 +84,14 @@
 	      (,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)))))
+	 (when ,c
+	   (,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.10 src/pcl/simple-streams/external-formats/utf-16-le.lisp:1.11
--- src/pcl/simple-streams/external-formats/utf-16-le.lisp:1.10	Mon Jul 12 10:42:11 2010
+++ src/pcl/simple-streams/external-formats/utf-16-le.lisp	Thu Aug 12 21:35:25 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.10 2010-07-12 14:42:11 rtoy Exp $")
+(ext:file-comment "$Header: /project/cmucl/cvsroot/src/pcl/simple-streams/external-formats/utf-16-le.lisp,v 1.11 2010-08-13 01:35:25 rtoy Exp $")
 
 (in-package "STREAM")
 (intl:textdomain "cmucl")
@@ -85,13 +85,14 @@
 	      (,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)))))
+	 (when ,c
+	   (,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.