November 2005 - cxml-cvs@common-lisp.net - mailman3.common-lisp.net

[cxml-cvs] CVS update: cxml/xml/package.lisp cxml/xml/xml-parse.lisp
by dlichteblau＠common-lisp.net 27 Nov '05

27 Nov '05

Update of /project/cxml/cvsroot/cxml/xml In directory common-lisp.net:/tmp/cvs-serv9524/xml Modified Files: package.lisp xml-parse.lisp Log Message: -ibm/not-wf/P32/ibm32n09.xml [not validating:] FAILED: - well-formedness violation not detected -[ - This is test violates WFC: Entity Declared in P68. - The standalone document declaration has the value yes, BUT there is an - external markup declaration of an entity (other than amp, lt, gt, apos, - quot), and references to this entity appear in the document. - ] Date: Sun Nov 27 19:41:07 2005 Author: dlichteblau Index: cxml/xml/package.lisp diff -u cxml/xml/package.lisp:1.4 cxml/xml/package.lisp:1.5 --- cxml/xml/package.lisp:1.4 Sun Nov 27 01:51:36 2005 +++ cxml/xml/package.lisp Sun Nov 27 19:41:07 2005 @@ -6,7 +6,7 @@ (in-package :cl-user) (defpackage :cxml - (:use :cl :runes :encoding :trivial-gray-streams) + (:use :cl :runes :runes-encoding :trivial-gray-streams) (:export ;; xstreams #:make-xstream Index: cxml/xml/xml-parse.lisp diff -u cxml/xml/xml-parse.lisp:1.36 cxml/xml/xml-parse.lisp:1.37 --- cxml/xml/xml-parse.lisp:1.36 Sun Nov 27 19:20:11 2005 +++ cxml/xml/xml-parse.lisp Sun Nov 27 19:41:07 2005 @@ -62,7 +62,7 @@ ;; slot of zstreams instead). ;; Common -;; :xml-pi (<target> . <content>) ;processing-instruction starting with "<?xml" +;; :xml-decl (<target> . <content>) ;processing-instruction starting with "<?xml" ;; :pi (<target> . <content>) ;processing-instruction ;; :stag (<name> . <atts>) ;start tag ;; :etag (<name> . <atts>) ;end tag @@ -665,7 +665,7 @@ :format-arguments (list stream x args))) (defvar *validate* t) -(defvar *markup-declaration-external-p* nil) +(defvar *external-subset-p* nil) (defun validate-start-element (ctx name) (when *validate* @@ -816,7 +816,8 @@ (:constructor make-internal-entdef (value)) (:conc-name #:entdef-)) (value (error "missing argument") :type rod) - (expansion nil)) + (expansion nil) + (external-subset-p *external-subset-p*)) (defstruct (external-entdef (:include entdef) @@ -889,7 +890,7 @@ (setf (entdef-extid def) (absolute-extid source-stream (entdef-extid def)))) (setf (gethash name table) - (cons *markup-declaration-external-p* def))))) + (cons *external-subset-p* def))))) (defun get-entity-definition (entity-name kind dtd) (unless dtd @@ -913,6 +914,10 @@ (let (r) (etypecase def (internal-entdef + (when (and (standalone-p *ctx*) + (entdef-external-subset-p def)) + (wf-error + "entity declared in external subset, but document is standalone")) (setf r (make-rod-xstream (entdef-value def))) (setf (xstream-name r) (make-stream-name :entity-name entity-name @@ -977,7 +982,7 @@ ; (:ENUMERATION <name>*) default ;default value of attribute: ; :REQUIRED, :IMPLIED, (:FIXED content) or (:DEFAULT content) - (external-p *markup-declaration-external-p*) + (external-p *external-subset-p*) ) (defstruct elmdef @@ -986,7 +991,7 @@ content ;content model [*] attributes ;list of defined attributes compiled-cspec ;cons of validation function for contentspec - (external-p *markup-declaration-external-p*) + (external-p *external-subset-p*) ) ;; [*] in XML it is possible to define attributes before the element @@ -1060,7 +1065,7 @@ (rod-string element-name))))))) (sax:element-declaration (handler *ctx*) element-name content-model) (setf (elmdef-content e) content-model) - (setf (elmdef-external-p e) *markup-declaration-external-p*) + (setf (elmdef-external-p e) *external-subset-p*) e)))) (defvar *redefinition-warning* nil) @@ -1257,7 +1262,7 @@ ((rune= #/? d) (multiple-value-bind (target content) (read-pi input) (cond ((rod= target '#.(string-rod "xml")) - (values :xml-pi (cons target content))) + (values :xml-decl (cons target content))) ((rod-equal target '#.(string-rod "XML")) (wf-error "You lost -- no XML processing instructions.")) ((and sax:*namespace-processing* (position #/: target)) @@ -2348,7 +2353,7 @@ (:eof (return)) ((:|<!ELEMENT| :|<!ATTLIST| :|<!ENTITY| :|<!NOTATION| :PI :COMMENT) (let ((*expand-pe-p* t) - (*markup-declaration-external-p* t)) + (*external-subset-p* t)) (p/markup-decl input))) ((:PE-REFERENCE) (let ((name (nth-value 1 (read-token input)))) @@ -2377,7 +2382,7 @@ ;; | EntityDecl | NotationDecl ;; | PI | Comment /* WFC: PEs in Internal Subset */ (let ((token (peek-token input)) - (*expand-pe-p* (and *expand-pe-p* *markup-declaration-external-p*))) + (*expand-pe-p* (and *expand-pe-p* *external-subset-p*))) (case token (:|<!ELEMENT| (p/element-decl input)) (:|<!ATTLIST| (p/attlist-decl input)) @@ -2405,7 +2410,7 @@ (set-to-full-speed xstream)))) (defun p/ext-subset (input) - (cond ((eq (peek-token input) :xml-pi) + (cond ((eq (peek-token input) :xml-decl) (let ((hd (parse-text-decl (cdr (nth-value 1 (peek-token input)))))) (setup-encoding input hd)) (consume-token input))) @@ -2554,7 +2559,7 @@ ;; we will use the attribute-value parser for the xml decl. (let ((*data-behaviour* :DTD)) ;; optional XMLDecl? - (cond ((eq (peek-token input) :xml-pi) + (cond ((eq (peek-token input) :xml-decl) (let ((hd (parse-xml-decl (cdr (nth-value 1 (peek-token input)))))) (setf (standalone-p *ctx*) (eq (xml-header-standalone-p hd) :yes)) (setup-encoding input hd)) @@ -2737,7 +2742,7 @@ (defun p/ext-parsed-ent (input) ;; [78] extParsedEnt ::= '<?xml' VersionInfo? EncodingDecl S? '?>' content - (when (eq (peek-token input) :xml-pi) + (when (eq (peek-token input) :xml-decl) (let ((hd (parse-text-decl (cdr (nth-value 1 (peek-token input)))))) (setup-encoding input hd)) (consume-token input))

1 0

[cxml-cvs] CVS update: cxml/XMLCONF
by dlichteblau＠common-lisp.net 27 Nov '05

27 Nov '05

Update of /project/cxml/cvsroot/cxml In directory common-lisp.net:/tmp/cvs-serv9524 Modified Files: XMLCONF Log Message: -ibm/not-wf/P32/ibm32n09.xml [not validating:] FAILED: - well-formedness violation not detected -[ - This is test violates WFC: Entity Declared in P68. - The standalone document declaration has the value yes, BUT there is an - external markup declaration of an entity (other than amp, lt, gt, apos, - quot), and references to this entity appear in the document. - ] Date: Sun Nov 27 19:41:07 2005 Author: dlichteblau Index: cxml/XMLCONF diff -u cxml/XMLCONF:1.32 cxml/XMLCONF:1.33 --- cxml/XMLCONF:1.32 Sun Nov 27 19:20:08 2005 +++ cxml/XMLCONF Sun Nov 27 19:41:06 2005 @@ -469,11 +469,7 @@ sun/invalid/utf16b.xml [not validating:] input [validating:] invalid sun/invalid/utf16l.xml [not validating:] input [validating:] invalid sun/invalid/empty.xml [not validating:] input [validating:] invalid -sun/not-wf/not-sa03.xml [not validating:] FAILED: - well-formedness violation not detected -[ - Tests the Entity Declared WFC, ensuring that - a reference to externally defined entity causes a well-formedness error.] +sun/not-wf/not-sa03.xml [not validating:] not-wf [validating:] invalid sun/not-wf/attlist01.xml [not validating:] not-wf [validating:] not-wf sun/not-wf/attlist02.xml [not validating:] not-wf [validating:] not-wf sun/not-wf/attlist03.xml [not validating:] not-wf [validating:] not-wf @@ -1100,14 +1096,7 @@ Tests SDDecl with wrong field ordering. The "=" sign occurs after the key word "yes" in the SDDecl in the XMLDecl. ] -ibm/not-wf/P32/ibm32n09.xml [not validating:] FAILED: - well-formedness violation not detected -[ - This is test violates WFC: Entity Declared in P68. - The standalone document declaration has the value yes, BUT there is an - external markup declaration of an entity (other than amp, lt, gt, apos, - quot), and references to this entity appear in the document. - ] +ibm/not-wf/P32/ibm32n09.xml [not validating:] not-wf [validating:] invalid ibm/not-wf/P39/ibm39n01.xml [not validating:] not-wf [validating:] not-wf ibm/not-wf/P39/ibm39n02.xml [not validating:] not-wf [validating:] not-wf ibm/not-wf/P39/ibm39n03.xml [not validating:] not-wf [validating:] not-wf @@ -1289,13 +1278,7 @@ ibm/not-wf/P68/ibm68n03.xml [not validating:] not-wf [validating:] not-wf ibm/not-wf/P68/ibm68n04.xml [not validating:] not-wf [validating:] not-wf ibm/not-wf/P68/ibm68n05.xml [not validating:] not-wf [validating:] not-wf -ibm/not-wf/P68/ibm68n06.xml [not validating:] FAILED: - well-formedness violation not detected -[ - Tests EntityRef which is against P68 WFC: Entity Declared. The - entity with the name "aaa" in the EntityRef in the AttValue in the STag of - the element "root" is externally declared, but standalone is "yes". - ] +ibm/not-wf/P68/ibm68n06.xml [not validating:] not-wf [validating:] invalid ibm/not-wf/P68/ibm68n07.xml [not validating:] not-wf [validating:] not-wf ibm/not-wf/P68/ibm68n08.xml [not validating:] not-wf [validating:] not-wf ibm/not-wf/P68/ibm68n09.xml [not validating:] not-wf [validating:] not-wf @@ -1853,4 +1836,4 @@ ibm/valid/P87/ibm87v01.xml [not validating:] input [validating:] input ibm/valid/P88/ibm88v01.xml [not validating:] input [validating:] input ibm/valid/P89/ibm89v01.xml [not validating:] input [validating:] input -13/1786 tests failed; 376 tests were skipped \ No newline at end of file +10/1786 tests failed; 376 tests were skipped \ No newline at end of file

1 0

[cxml-cvs] CVS update: cxml/xml/xml-parse.lisp
by dlichteblau＠common-lisp.net 27 Nov '05

27 Nov '05

Update of /project/cxml/cvsroot/cxml/xml In directory common-lisp.net:/tmp/cvs-serv8375/xml Modified Files: xml-parse.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:11 2005 Author: dlichteblau Index: cxml/xml/xml-parse.lisp diff -u cxml/xml/xml-parse.lisp:1.35 cxml/xml/xml-parse.lisp:1.36 --- cxml/xml/xml-parse.lisp:1.35 Sun Nov 27 18:19:14 2005 +++ cxml/xml/xml-parse.lisp Sun Nov 27 19:20:11 2005 @@ -1413,15 +1413,18 @@ (definline data-rune-p (rune) ;; any Unicode character, excluding the surrogate blocks, FFFE, and FFFF. + ;; + ;; FIXME: das halte ich fuer verkehrt. Surrogates als Unicode-Zeichen + ;; sind verboten. Das liegt hier aber nicht vor, denn wir arbeiten + ;; ja tatsaechlich mit UTF-16. Verboten ist es nur, wenn wir ein + ;; solches Zeichen beim Dekodieren finden, das wird aber eben + ;; in encodings.lisp bereits geprueft. --david (let ((c (rune-code rune))) (or (= c #x9) (= c #xA) (= c #xD) (<= #x20 c #xD7FF) (<= #xE000 c #xFFFD) - ;; (<= #xD800 c #xDBFF) - (<= #xDC00 c #xDFFF) - ;; - ))) + (<= #xDC00 c #xDFFF)))) (defun read-att-value (zinput input mode &optional canon-space-p (delim nil)) (with-rune-collector-2 (collect) @@ -2686,7 +2689,7 @@ ((:ENTITY-REF) (let ((name sem)) (consume-token input) - (append ;; nil #+(OR) + (append (recurse-on-entity input name :general (lambda (input) (prog1 @@ -3190,17 +3193,10 @@ (defun read-cdata (input) (read-data-until* ((lambda (rune) (declare (type rune rune)) - (when (or (and (%rune< rune #/U+0020) - (not (or (%rune= rune #/U+0009) - (%rune= rune #/U+000a) - (%rune= rune #/U+000d)))) - ;; Surrogates nicht ausschliessen, denn wir - ;; haben ja UTF-16 Runen. - #+(or) - (and (%rune<= #/U+D800 rune) - (%rune< rune #/U+E000)) - (%rune= rune #/U+FFFE) - (%rune= rune #/U+FFFF)) + (when (and (%rune< rune #/U+0020) + (not (or (%rune= rune #/U+0009) + (%rune= rune #/U+000a) + (%rune= rune #/U+000d)))) (wf-error "code point invalid: ~A" rune)) (or (%rune= rune #/<) (%rune= rune #/&))) input

1 0

[cxml-cvs] CVS update: cxml/runes/encodings.lisp
by dlichteblau＠common-lisp.net 27 Nov '05

27 Nov '05

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))

1 0

[cxml-cvs] CVS update: cxml/XMLCONF
by dlichteblau＠common-lisp.net 27 Nov '05

27 Nov '05

Update of /project/cxml/cvsroot/cxml In directory common-lisp.net:/tmp/cvs-serv8375 Modified Files: XMLCONF 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:09 2005 Author: dlichteblau Index: cxml/XMLCONF diff -u cxml/XMLCONF:1.31 cxml/XMLCONF:1.32 --- cxml/XMLCONF:1.31 Sun Nov 27 18:34:22 2005 +++ cxml/XMLCONF Sun Nov 27 19:20:08 2005 @@ -168,10 +168,7 @@ xmltest/not-wf/sa/168.xml [not validating:] not-wf [validating:] invalid xmltest/not-wf/sa/169.xml [not validating:] not-wf [validating:] invalid xmltest/not-wf/sa/170.xml [not validating:] not-wf [validating:] invalid -xmltest/not-wf/sa/171.xml [not validating:] FAILED: - well-formedness violation not detected -[ - Character FFFF is not legal anywhere in an XML document. ] +xmltest/not-wf/sa/171.xml [not validating:] not-wf [validating:] not-wf xmltest/not-wf/sa/172.xml [not validating:] not-wf [validating:] not-wf xmltest/not-wf/sa/173.xml [not validating:] not-wf [validating:] not-wf xmltest/not-wf/sa/174.xml [not validating:] not-wf [validating:] invalid @@ -1856,4 +1853,4 @@ ibm/valid/P87/ibm87v01.xml [not validating:] input [validating:] input ibm/valid/P88/ibm88v01.xml [not validating:] input [validating:] input ibm/valid/P89/ibm89v01.xml [not validating:] input [validating:] input -14/1786 tests failed; 376 tests were skipped \ No newline at end of file +13/1786 tests failed; 376 tests were skipped \ No newline at end of file

1 0

[cxml-cvs] CVS update: cxml/XMLCONF
by dlichteblau＠common-lisp.net 27 Nov '05

27 Nov '05

Update of /project/cxml/cvsroot/cxml In directory common-lisp.net:/tmp/cvs-serv5138 Modified Files: XMLCONF Log Message: -xmltest/not-wf/sa/170.xml [not validating:] FAILED: - well-formedness violation not detected -[ - Four byte UTF-8 encodings can encode UCS-4 characters - which are beyond the range of legal XML characters - (and can't be expressed in Unicode surrogate pairs). - This document holds such a character. ] Date: Sun Nov 27 18:34:23 2005 Author: dlichteblau Index: cxml/XMLCONF diff -u cxml/XMLCONF:1.30 cxml/XMLCONF:1.31 --- cxml/XMLCONF:1.30 Sun Nov 27 18:19:10 2005 +++ cxml/XMLCONF Sun Nov 27 18:34:22 2005 @@ -167,13 +167,7 @@ xmltest/not-wf/sa/167.xml [not validating:] not-wf [validating:] invalid xmltest/not-wf/sa/168.xml [not validating:] not-wf [validating:] invalid xmltest/not-wf/sa/169.xml [not validating:] not-wf [validating:] invalid -xmltest/not-wf/sa/170.xml [not validating:] FAILED: - well-formedness violation not detected -[ - Four byte UTF-8 encodings can encode UCS-4 characters - which are beyond the range of legal XML characters - (and can't be expressed in Unicode surrogate pairs). - This document holds such a character. ] +xmltest/not-wf/sa/170.xml [not validating:] not-wf [validating:] invalid xmltest/not-wf/sa/171.xml [not validating:] FAILED: well-formedness violation not detected [ @@ -1862,4 +1856,4 @@ ibm/valid/P87/ibm87v01.xml [not validating:] input [validating:] input ibm/valid/P88/ibm88v01.xml [not validating:] input [validating:] input ibm/valid/P89/ibm89v01.xml [not validating:] input [validating:] input -15/1786 tests failed; 376 tests were skipped \ No newline at end of file +14/1786 tests failed; 376 tests were skipped \ No newline at end of file

1 0

[cxml-cvs] CVS update: cxml/runes/encodings.lisp
by dlichteblau＠common-lisp.net 27 Nov '05

27 Nov '05

Update of /project/cxml/cvsroot/cxml/runes In directory common-lisp.net:/tmp/cvs-serv5138/runes Modified Files: encodings.lisp Log Message: -xmltest/not-wf/sa/170.xml [not validating:] FAILED: - well-formedness violation not detected -[ - Four byte UTF-8 encodings can encode UCS-4 characters - which are beyond the range of legal XML characters - (and can't be expressed in Unicode surrogate pairs). - This document holds such a character. ] Date: Sun Nov 27 18:34:23 2005 Author: dlichteblau Index: cxml/runes/encodings.lisp diff -u cxml/runes/encodings.lisp:1.2 cxml/runes/encodings.lisp:1.3 --- cxml/runes/encodings.lisp:1.2 Sun Nov 27 18:19:12 2005 +++ cxml/runes/encodings.lisp Sun Nov 27 18:34:23 2005 @@ -160,8 +160,10 @@ `((lambda (x) (when (or (<= #xD800 x #xDBFF) (<= #xDC00 x #xDFFF)) - (xerror "surrogate encoded in UTF-8: #x~x." x)) - (cond ((%> x #xFFFF) + (xerror "surrogate encoded in UTF-8: #x~X." x)) + (cond ((%> x #x10FFFF) + (xerror "not a valid code point: #x~X" x)) + ((%> x #xFFFF) (setf (aref out (%+ 0 wptr)) (%+ #xD7C0 (ash x -10)) (aref out (%+ 1 wptr)) (%ior #xDC00 (%and x #x3FF))) (setf wptr (%+ wptr 2)))

1 0

[cxml-cvs] CVS update: cxml/xml/xml-parse.lisp
by dlichteblau＠common-lisp.net 27 Nov '05

27 Nov '05

Update of /project/cxml/cvsroot/cxml/xml In directory common-lisp.net:/tmp/cvs-serv4026/xml Modified Files: xml-parse.lisp Log Message: encoding-fehler resignalisieren Date: Sun Nov 27 18:19:14 2005 Author: dlichteblau Index: cxml/xml/xml-parse.lisp diff -u cxml/xml/xml-parse.lisp:1.34 cxml/xml/xml-parse.lisp:1.35 --- cxml/xml/xml-parse.lisp:1.34 Sun Nov 27 17:49:22 2005 +++ cxml/xml/xml-parse.lisp Sun Nov 27 18:19:14 2005 @@ -2960,10 +2960,13 @@ :type type)))))) (defun parse-xstream (xstream handler &rest args) - (let ((zstream (make-zstream :input-stack (list xstream)))) - (peek-rune xstream) - (with-scratch-pads () - (apply #'p/document zstream handler args)))) + (handler-case + (let ((zstream (make-zstream :input-stack (list xstream)))) + (peek-rune xstream) + (with-scratch-pads () + (apply #'p/document zstream handler args))) + (runes-encoding:encoding-error (c) + (wf-error "~A" c)))) (defun parse-file (filename handler &rest args) (with-open-xfile (input filename) @@ -3021,10 +3024,7 @@ (defun parse-string (string handler) ;; XXX this function mis-handles encoding - (with-scratch-pads () - (let* ((x (string->xstream string)) - (z (make-zstream :input-stack (list x)))) - (p/document z handler)))) + (parse-xstream (string->xstream string) handler)) (defun string->xstream (string) ;; XXX encoding is mis-handled by this kind of stream

1 0

[cxml-cvs] CVS update: cxml/runes/encodings-data.lisp cxml/runes/encodings.lisp cxml/runes/package.lisp cxml/runes/xstream.lisp
by dlichteblau＠common-lisp.net 27 Nov '05

27 Nov '05

Update of /project/cxml/cvsroot/cxml/runes In directory common-lisp.net:/tmp/cvs-serv4026/runes Modified Files: encodings-data.lisp encodings.lisp package.lisp xstream.lisp Log Message: encoding-fehler resignalisieren Date: Sun Nov 27 18:19:12 2005 Author: dlichteblau Index: cxml/runes/encodings-data.lisp diff -u cxml/runes/encodings-data.lisp:1.1.1.1 cxml/runes/encodings-data.lisp:1.2 --- cxml/runes/encodings-data.lisp:1.1.1.1 Sun Mar 13 19:02:27 2005 +++ cxml/runes/encodings-data.lisp Sun Nov 27 18:19:12 2005 @@ -1,4 +1,4 @@ -(in-package :encoding) +(in-package :runes-encoding) (progn (add-name :us-ascii "ANSI_X3.4-1968") Index: cxml/runes/encodings.lisp diff -u cxml/runes/encodings.lisp:1.1.1.1 cxml/runes/encodings.lisp:1.2 --- cxml/runes/encodings.lisp:1.1.1.1 Sun Mar 13 19:02:27 2005 +++ cxml/runes/encodings.lisp Sun Nov 27 18:19:12 2005 @@ -1,4 +1,9 @@ -(in-package :encoding) +(in-package :runes-encoding) + +(define-condition encoding-error (simple-error) ()) + +(defun xerror (fmt &rest args) + (error 'encoding-error :format-control fmt :format-arguments args)) ;;;; --------------------------------------------------------------------------- ;;;; Encoding names @@ -115,6 +120,9 @@ (let ((hi (aref in rptr)) (lo (aref in (%+ 1 rptr)))) (setf rptr (%+ 2 rptr)) + ;; 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)) (setf wptr (%+ 1 wptr)))) (values wptr rptr))) @@ -132,6 +140,9 @@ (let ((lo (aref in (%+ 0 rptr))) (hi (aref in (%+ 1 rptr)))) (setf rptr (%+ 2 rptr)) + ;; 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)) (setf wptr (%+ 1 wptr)))) (values wptr rptr))) @@ -147,13 +158,9 @@ byte0) (macrolet ((put (x) `((lambda (x) - (cond ((or (<= #xD800 x #xDBFF) - (<= #xDC00 x #xDFFF)) - (error "Encoding UTF-16 in UTF-8? : #x~x." x))) - '(unless (data-char-p x) - (error "#x~x is not a data character." x)) - ;;(fresh-line) - ;;(prin1 x) (princ "-> ") + (when (or (<= #xD800 x #xDBFF) + (<= #xDC00 x #xDFFF)) + (xerror "surrogate encoded in UTF-8: #x~x." x)) (cond ((%> x #xFFFF) (setf (aref out (%+ 0 wptr)) (%+ #xD7C0 (ash x -10)) (aref out (%+ 1 wptr)) (%ior #xDC00 (%and x #x3FF))) @@ -196,7 +203,7 @@ (setf rptr (%+ rptr 1))) ((%<= #|#b10000000|# byte0 #b10111111) - (error "Corrupted UTF-8 input (initial byte was #b~8,'0B)" byte0) + (xerror "Corrupted UTF-8 input (initial byte was #b~8,'0B)" byte0) (setf rptr (%+ rptr 1))) ((%<= #|#b11000000|# byte0 #b11011111) @@ -260,7 +267,7 @@ (return)))) (t - (error "Corrupted UTF-8 input (initial byte was #b~8,'0B)" byte0)) ) )) + (xerror "Corrupted UTF-8 input (initial byte was #b~8,'0B)" byte0)) ) )) (values wptr rptr)) ) (defmethod encoding-p ((object (eql :utf-16-little-endian))) t) @@ -343,5 +350,4 @@ (defun find-charset (name) (or (gethash name *charsets*) - (error "There is no character set named ~S." name))) - + (xerror "There is no character set named ~S." name))) Index: cxml/runes/package.lisp diff -u cxml/runes/package.lisp:1.2 cxml/runes/package.lisp:1.3 --- cxml/runes/package.lisp:1.2 Fri Mar 25 19:16:56 2005 +++ cxml/runes/package.lisp Sun Nov 27 18:19:12 2005 @@ -61,8 +61,9 @@ #:set-to-full-speed #:xstream-name)) -(defpackage :encoding +(defpackage :runes-encoding (:use :cl :runes) (:export + #:encoding-error #:find-encoding #:decode-sequence)) Index: cxml/runes/xstream.lisp diff -u cxml/runes/xstream.lisp:1.2 cxml/runes/xstream.lisp:1.3 --- cxml/runes/xstream.lisp:1.2 Fri Mar 25 19:16:56 2005 +++ cxml/runes/xstream.lisp Sun Nov 27 18:19:12 2005 @@ -1,4 +1,4 @@ -;;; -*- Mode: Lisp; Syntax: Common-Lisp; Package: runes; readtable: runes; Encoding: utf-8; -*- +;;; -*- Mode: Lisp; Syntax: Common-Lisp; readtable: runes; Encoding: utf-8; -*- ;;; --------------------------------------------------------------------------- ;;; Title: Fast streams ;;; Created: 1999-07-17 @@ -66,9 +66,7 @@ ;; (eval-when (:compile-toplevel :load-toplevel :execute) - (defparameter *fast* '(optimize (speed 3) (safety 0))) - ;;(defparameter *fast* '(optimize (speed 2) (safety 3))) - ) + (defparameter *fast* '(optimize (speed 3) (safety 0)))) ;; Let us first define fast fixnum arithmetric get rid of type ;; checks. (After all we know what we do here). @@ -277,10 +275,14 @@ :end2 (xstream-os-left-end input)) ;; then we take care that the buffer is large enough to carry at ;; least 100 bytes (a random number) + ;; + ;; david: was heisst da random? ich nehme an, dass 100 einfach + ;; ausreichend sein soll, um die laengste utf-8 bytesequenz oder die + ;; beiden utf-16 surrogates zu halten? dann ist 100 ja wohl dicke + ;; ausreichend und koennte in make-xstream ordentlich geprueft werden. + ;; oder was geht hier vor? (unless (>= (length (xstream-os-buffer input)) 100) - (error "You lost") - ;; todo: enlarge buffer - )) + (error "You lost"))) (setf n (read-octets (xstream-os-buffer input) (xstream-os-stream input) m (min (1- (length (xstream-os-buffer input))) @@ -292,7 +294,7 @@ :eof) (t (multiple-value-bind (fnw fnr) - (encoding:decode-sequence + (runes-encoding:decode-sequence (xstream-encoding input) (xstream-os-buffer input) 0 n (xstream-buffer input) 0 (1- (length (xstream-buffer input)))

1 0

[cxml-cvs] CVS update: cxml/XMLCONF
by dlichteblau＠common-lisp.net 27 Nov '05

27 Nov '05

Update of /project/cxml/cvsroot/cxml In directory common-lisp.net:/tmp/cvs-serv4026 Modified Files: XMLCONF Log Message: encoding-fehler resignalisieren Date: Sun Nov 27 18:19:11 2005 Author: dlichteblau Index: cxml/XMLCONF diff -u cxml/XMLCONF:1.29 cxml/XMLCONF:1.30 --- cxml/XMLCONF:1.29 Sun Nov 27 17:49:21 2005 +++ cxml/XMLCONF Sun Nov 27 18:19:10 2005 @@ -165,16 +165,8 @@ xmltest/not-wf/sa/165.xml [not validating:] not-wf [validating:] not-wf xmltest/not-wf/sa/166.xml [not validating:] not-wf [validating:] invalid xmltest/not-wf/sa/167.xml [not validating:] not-wf [validating:] invalid -xmltest/not-wf/sa/168.xml [not validating:] FAILED: - Encoding UTF-16 in UTF-8? : #xD800. -[ - An unpaired surrogate (D800) is not legal anywhere - in an XML document.] -xmltest/not-wf/sa/169.xml [not validating:] FAILED: - Encoding UTF-16 in UTF-8? : #xDC00. -[ - An unpaired surrogate (DC00) is not legal anywhere - in an XML document.] +xmltest/not-wf/sa/168.xml [not validating:] not-wf [validating:] invalid +xmltest/not-wf/sa/169.xml [not validating:] not-wf [validating:] invalid xmltest/not-wf/sa/170.xml [not validating:] FAILED: well-formedness violation not detected [ @@ -968,16 +960,8 @@ ibm/not-wf/P02/ibm02n27.xml [not validating:] not-wf [validating:] not-wf ibm/not-wf/P02/ibm02n28.xml [not validating:] not-wf [validating:] not-wf ibm/not-wf/P02/ibm02n29.xml [not validating:] not-wf [validating:] not-wf -ibm/not-wf/P02/ibm02n30.xml [not validating:] FAILED: - Encoding UTF-16 in UTF-8? : #xD800. -[ - Tests a comment which contains an illegal Char: #xD800 - ] -ibm/not-wf/P02/ibm02n31.xml [not validating:] FAILED: - Encoding UTF-16 in UTF-8? : #xDFFF. -[ - Tests a comment which contains an illegal Char: #xDFFF - ] +ibm/not-wf/P02/ibm02n30.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P02/ibm02n31.xml [not validating:] not-wf [validating:] not-wf ibm/not-wf/P02/ibm02n32.xml [not validating:] not-wf [validating:] not-wf ibm/not-wf/P02/ibm02n33.xml [not validating:] not-wf [validating:] not-wf ibm/not-wf/P03/ibm03n01.xml [not validating:] not-wf [validating:] not-wf @@ -1878,4 +1862,4 @@ ibm/valid/P87/ibm87v01.xml [not validating:] input [validating:] input ibm/valid/P88/ibm88v01.xml [not validating:] input [validating:] input ibm/valid/P89/ibm89v01.xml [not validating:] input [validating:] input -19/1786 tests failed; 376 tests were skipped \ No newline at end of file +15/1786 tests failed; 376 tests were skipped \ No newline at end of file

1 0