[cxml-cvs] CVS update: cxml/runes/encodings.lisp

[David Lichteblau]

Update of /project/cxml/cvsroot/cxml/runes
In directory common-lisp.net:/tmp/cvs-serv8375/runes

Modified Files:
	encodings.lisp 
Log Message:
Hmm.  Auf U+ffff und dergleichen wurde durch data-rune-p geprueft,
das aber eben nicht ueberall benutzt wurde.  Ich habe die Pruefung
jetzt mal direkt im Decoding eingebaut.

-xmltest/not-wf/sa/171.xml [not validating:] FAILED:
-  well-formedness violation not detected
-[
-    Character FFFF is not legal anywhere in an XML document. ]

Date: Sun Nov 27 19:20:10 2005
Author: dlichteblau

Index: cxml/runes/encodings.lisp
diff -u cxml/runes/encodings.lisp:1.3 cxml/runes/encodings.lisp:1.4
--- cxml/runes/encodings.lisp:1.3	Sun Nov 27 18:34:23 2005
+++ cxml/runes/encodings.lisp	Sun Nov 27 19:20:10 2005
@@ -123,7 +123,10 @@
 	;; FIXME: Wenn wir hier ein Surrogate sehen, muessen wir das naechste
 	;; Zeichen abwarten und nachgucken, dass nicht etwa die andere
 	;; Haelfte fehlt!
-        (setf (aref out wptr) (logior (ash hi 8) lo))
+        (let ((x (logior (ash hi 8) lo)))
+	  (when (or (eql x #xFFFE) (eql x #/U+FFFF))
+	    (xerror "not a valid code point: #x~X" x))
+	  (setf (aref out wptr) x))
         (setf wptr (%+ 1 wptr))))
     (values wptr rptr)))
 
@@ -143,7 +146,10 @@
 	;; FIXME: Wenn wir hier ein Surrogate sehen, muessen wir das naechste
 	;; Zeichen abwarten und nachgucken, dass nicht etwa die andere
 	;; Haelfte fehlt!
-        (setf (aref out wptr) (logior (ash hi 8) lo))
+        (let ((x (logior (ash hi 8) lo)))
+	  (when (or (eql x #xFFFE) (eql x #/U+FFFF))
+	    (xerror "not a valid code point: #x~X" x))
+	  (setf (aref out wptr) x))
         (setf wptr (%+ 1 wptr))))
     (values wptr rptr)))
 
@@ -161,7 +167,9 @@
                      (when (or (<= #xD800 x #xDBFF)
 			       (<= #xDC00 x #xDFFF))
 		       (xerror "surrogate encoded in UTF-8: #x~X." x))
-                     (cond ((%> x #x10FFFF)
+                     (cond ((or (%> x #x10FFFF)
+				(eql x #xFFFE)
+				(eql x #/U+FFFF))
                             (xerror "not a valid code point: #x~X" x))
 		           ((%> x #xFFFF)
                             (setf (aref out (%+ 0 wptr)) (%+ #xD7C0 (ash x -10))