*)
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))
((:|' 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))
From dlichteblau at common-lisp.net Sun Nov 27 19:28:47 2005
From: dlichteblau at common-lisp.net (David Lichteblau)
Date: Sun, 27 Nov 2005 20:28:47 +0100 (CET)
Subject: [cxml-cvs] CVS update: cxml/XMLCONF
Message-ID: <20051127192847.3BC52880D5@common-lisp.net>
Update of /project/cxml/cvsroot/cxml
In directory common-lisp.net:/tmp/cvs-serv12853
Modified Files:
XMLCONF
Log Message:
ich sag nur: 'foo
Date: Sun Nov 27 20:28:45 2005
Author: dlichteblau
Index: cxml/XMLCONF
diff -u cxml/XMLCONF:1.33 cxml/XMLCONF:1.34
--- cxml/XMLCONF:1.33 Sun Nov 27 19:41:06 2005
+++ cxml/XMLCONF Sun Nov 27 20:28:45 2005
@@ -734,10 +734,7 @@
oasis/p23fail5.xml [not validating:] not-wf [validating:] not-wf
oasis/p24fail1.xml [not validating:] not-wf [validating:] not-wf
oasis/p24fail2.xml [not validating:] not-wf [validating:] not-wf
-oasis/p25fail1.xml [not validating:] FAILED:
- The value CXML::FOO is not of type RUNES::XSTREAM.
-[
- Comment is illegal in VersionInfo. ]
+oasis/p25fail1.xml [not validating:] not-wf [validating:] not-wf
oasis/p26fail1.xml [not validating:] not-wf [validating:] not-wf
oasis/p26fail2.xml [not validating:] not-wf [validating:] not-wf
oasis/p27fail1.xml [not validating:] not-wf [validating:] not-wf
@@ -1035,29 +1032,15 @@
missing in the VersionInfo in the XMLDecl.
]
ibm/not-wf/P24/ibm24n02.xml [not validating:] not-wf [validating:] not-wf
-ibm/not-wf/P24/ibm24n03.xml [not validating:] FAILED:
- The value CXML::FOO is not of type RUNES::XSTREAM.
-[
- Tests VersionInfo with a required field missing. The "="
- (equal sign) is missing between the key word "version" and the VersionNum.
- ]
+ibm/not-wf/P24/ibm24n03.xml [not validating:] not-wf [validating:] not-wf
ibm/not-wf/P24/ibm24n04.xml [not validating:] not-wf [validating:] not-wf
-ibm/not-wf/P24/ibm24n05.xml [not validating:] FAILED:
- The value CXML::FOO is not of type RUNES::XSTREAM.
-[
- Tests VersionInfo with wrong field ordering. The "=" occurs
- after "version" and the VersionNum.
- ]
+ibm/not-wf/P24/ibm24n05.xml [not validating:] not-wf [validating:] not-wf
ibm/not-wf/P24/ibm24n06.xml [not validating:] not-wf [validating:] not-wf
ibm/not-wf/P24/ibm24n07.xml [not validating:] not-wf [validating:] not-wf
ibm/not-wf/P24/ibm24n08.xml [not validating:] not-wf [validating:] not-wf
ibm/not-wf/P24/ibm24n09.xml [not validating:] not-wf [validating:] not-wf
ibm/not-wf/P25/ibm25n01.xml [not validating:] not-wf [validating:] not-wf
-ibm/not-wf/P25/ibm25n02.xml [not validating:] FAILED:
- The value CXML::FOO is not of type RUNES::XSTREAM.
-[
- Tests eq with a wrong key word "eq".
- ]
+ibm/not-wf/P25/ibm25n02.xml [not validating:] not-wf [validating:] not-wf
ibm/not-wf/P26/ibm26n01.xml [not validating:] not-wf [validating:] not-wf
ibm/not-wf/P27/ibm27n01.xml [not validating:] not-wf [validating:] not-wf
ibm/not-wf/P28/ibm28n01.xml [not validating:] not-wf [validating:] not-wf
@@ -1079,23 +1062,13 @@
ibm/not-wf/P30/ibm30n01.xml [not validating:] not-wf [validating:] not-wf
ibm/not-wf/P31/ibm31n01.xml [not validating:] not-wf [validating:] not-wf
ibm/not-wf/P32/ibm32n01.xml [not validating:] not-wf [validating:] not-wf
-ibm/not-wf/P32/ibm32n02.xml [not validating:] FAILED:
- The value CXML::FOO is not of type RUNES::XSTREAM.
-[
- Tests SDDecl with a required field missing. The "=" sign is missing
- in the SDDecl in the XMLDecl.
- ]
+ibm/not-wf/P32/ibm32n02.xml [not validating:] not-wf [validating:] not-wf
ibm/not-wf/P32/ibm32n03.xml [not validating:] not-wf [validating:] not-wf
ibm/not-wf/P32/ibm32n04.xml [not validating:] not-wf [validating:] not-wf
ibm/not-wf/P32/ibm32n05.xml [not validating:] not-wf [validating:] not-wf
ibm/not-wf/P32/ibm32n06.xml [not validating:] not-wf [validating:] not-wf
ibm/not-wf/P32/ibm32n07.xml [not validating:] not-wf [validating:] not-wf
-ibm/not-wf/P32/ibm32n08.xml [not validating:] FAILED:
- The value CXML::FOO is not of type RUNES::XSTREAM.
-[
- Tests SDDecl with wrong field ordering. The "=" sign occurs
- after the key word "yes" in the SDDecl in the XMLDecl.
- ]
+ibm/not-wf/P32/ibm32n08.xml [not validating:] not-wf [validating:] not-wf
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
@@ -1339,12 +1312,7 @@
ibm/not-wf/P79/ibm79n01.xml [not validating:] not-wf [validating:] not-wf
ibm/not-wf/P79/ibm79n02.xml [not validating:] not-wf [validating:] not-wf
ibm/not-wf/P80/ibm80n01.xml [not validating:] not-wf [validating:] not-wf
-ibm/not-wf/P80/ibm80n02.xml [not validating:] FAILED:
- The value CXML::FOO is not of type RUNES::XSTREAM.
-[
- Tests EncodingDecl with a required field missing. The "=" sign is
- missing in the EncodingDecl in the XMLDecl.
- ]
+ibm/not-wf/P80/ibm80n02.xml [not validating:] not-wf [validating:] not-wf
ibm/not-wf/P80/ibm80n03.xml [not validating:] FAILED:
Argument X is not a REAL: :EOF
[
@@ -1836,4 +1804,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
-10/1786 tests failed; 376 tests were skipped
\ No newline at end of file
+3/1786 tests failed; 376 tests were skipped
\ No newline at end of file
From dlichteblau at common-lisp.net Sun Nov 27 19:28:47 2005
From: dlichteblau at common-lisp.net (David Lichteblau)
Date: Sun, 27 Nov 2005 20:28:47 +0100 (CET)
Subject: [cxml-cvs] CVS update: cxml/xml/xml-parse.lisp
Message-ID: <20051127192847.8AE8788554@common-lisp.net>
Update of /project/cxml/cvsroot/cxml/xml
In directory common-lisp.net:/tmp/cvs-serv12853/xml
Modified Files:
xml-parse.lisp
Log Message:
ich sag nur: 'foo
Date: Sun Nov 27 20:28:46 2005
Author: dlichteblau
Index: cxml/xml/xml-parse.lisp
diff -u cxml/xml/xml-parse.lisp:1.37 cxml/xml/xml-parse.lisp:1.38
--- cxml/xml/xml-parse.lisp:1.37 Sun Nov 27 19:41:07 2005
+++ cxml/xml/xml-parse.lisp Sun Nov 27 20:28:46 2005
@@ -2752,7 +2752,8 @@
(defun parse-xml-decl (content)
(let* ((res (make-xml-header))
(i (make-rod-xstream content))
- (atts (read-attribute-list 'foo i t))) ;xxx on 'foo
+ (z (make-zstream :input-stack (list i)))
+ (atts (read-attribute-list z i t)))
(unless (eq (peek-rune i) :eof)
(wf-error "Garbage at end of XMLDecl."))
;; versioninfo muss da sein
@@ -2808,7 +2809,8 @@
(defun parse-text-decl (content)
(let* ((res (make-xml-header))
(i (make-rod-xstream content))
- (atts (read-attribute-list 'foo i t))) ;xxx on 'foo
+ (z (make-zstream :input-stack (list i)))
+ (atts (read-attribute-list z i t)))
(unless (eq (peek-rune i) :eof)
(wf-error "Garbage at end of TextDecl"))
;; versioninfo optional
From dlichteblau at common-lisp.net Sun Nov 27 19:31:19 2005
From: dlichteblau at common-lisp.net (David Lichteblau)
Date: Sun, 27 Nov 2005 20:31:19 +0100 (CET)
Subject: [cxml-cvs] CVS update: cxml/XMLCONF
Message-ID: <20051127193119.AE00B880D5@common-lisp.net>
Update of /project/cxml/cvsroot/cxml
In directory common-lisp.net:/tmp/cvs-serv13276
Modified Files:
XMLCONF
Log Message:
*patsch* -- noch ein eof erschlagen
Date: Sun Nov 27 20:31:18 2005
Author: dlichteblau
Index: cxml/XMLCONF
diff -u cxml/XMLCONF:1.34 cxml/XMLCONF:1.35
--- cxml/XMLCONF:1.34 Sun Nov 27 20:28:45 2005
+++ cxml/XMLCONF Sun Nov 27 20:31:18 2005
@@ -1025,12 +1025,7 @@
ibm/not-wf/P23/ibm23n04.xml [not validating:] not-wf [validating:] not-wf
ibm/not-wf/P23/ibm23n05.xml [not validating:] not-wf [validating:] not-wf
ibm/not-wf/P23/ibm23n06.xml [not validating:] not-wf [validating:] not-wf
-ibm/not-wf/P24/ibm24n01.xml [not validating:] FAILED:
- Argument X is not a REAL: :EOF
-[
- Tests VersionInfo with a required field missing. The VersionNum is
- missing in the VersionInfo in the XMLDecl.
- ]
+ibm/not-wf/P24/ibm24n01.xml [not validating:] not-wf [validating:] not-wf
ibm/not-wf/P24/ibm24n02.xml [not validating:] not-wf [validating:] not-wf
ibm/not-wf/P24/ibm24n03.xml [not validating:] not-wf [validating:] not-wf
ibm/not-wf/P24/ibm24n04.xml [not validating:] not-wf [validating:] not-wf
@@ -1313,12 +1308,7 @@
ibm/not-wf/P79/ibm79n02.xml [not validating:] not-wf [validating:] not-wf
ibm/not-wf/P80/ibm80n01.xml [not validating:] not-wf [validating:] not-wf
ibm/not-wf/P80/ibm80n02.xml [not validating:] not-wf [validating:] not-wf
-ibm/not-wf/P80/ibm80n03.xml [not validating:] FAILED:
- Argument X is not a REAL: :EOF
-[
- Tests EncodingDecl with a required field missing. The double quoted
- EncName are missing in the EncodingDecl in the XMLDecl.
- ]
+ibm/not-wf/P80/ibm80n03.xml [not validating:] not-wf [validating:] not-wf
ibm/not-wf/P80/ibm80n04.xml [not validating:] not-wf [validating:] not-wf
ibm/not-wf/P80/ibm80n05.xml [not validating:] not-wf [validating:] not-wf
ibm/not-wf/P80/ibm80n06.xml [not validating:] not-wf [validating:] not-wf
@@ -1804,4 +1794,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
-3/1786 tests failed; 376 tests were skipped
\ No newline at end of file
+1/1786 tests failed; 376 tests were skipped
\ No newline at end of file
From dlichteblau at common-lisp.net Sun Nov 27 19:31:20 2005
From: dlichteblau at common-lisp.net (David Lichteblau)
Date: Sun, 27 Nov 2005 20:31:20 +0100 (CET)
Subject: [cxml-cvs] CVS update: cxml/xml/xml-parse.lisp
Message-ID: <20051127193120.D988188554@common-lisp.net>
Update of /project/cxml/cvsroot/cxml/xml
In directory common-lisp.net:/tmp/cvs-serv13276/xml
Modified Files:
xml-parse.lisp
Log Message:
*patsch* -- noch ein eof erschlagen
Date: Sun Nov 27 20:31:19 2005
Author: dlichteblau
Index: cxml/xml/xml-parse.lisp
diff -u cxml/xml/xml-parse.lisp:1.38 cxml/xml/xml-parse.lisp:1.39
--- cxml/xml/xml-parse.lisp:1.38 Sun Nov 27 20:28:46 2005
+++ cxml/xml/xml-parse.lisp Sun Nov 27 20:31:19 2005
@@ -3293,9 +3293,11 @@
(defun read-att-value-2 (input)
(let ((delim (read-rune input)))
+ (when (eql delim :eof)
+ (eox input))
(unless (member delim '(#/\" #/\') :test #'eql)
(wf-error "Bad attribute value delimiter ~S, must be either #\\\" or #\\\'."
- (rune-char delim delim)))
+ (rune-char delim)))
(with-rune-collector-4 (collect)
(loop
(let ((c (read-rune input)))
From dlichteblau at common-lisp.net Sun Nov 27 19:37:42 2005
From: dlichteblau at common-lisp.net (David Lichteblau)
Date: Sun, 27 Nov 2005 20:37:42 +0100 (CET)
Subject: [cxml-cvs] CVS update: cxml/XMLCONF
Message-ID: <20051127193742.E4B00880D5@common-lisp.net>
Update of /project/cxml/cvsroot/cxml
In directory common-lisp.net:/tmp/cvs-serv14037
Modified Files:
XMLCONF
Log Message:
'<'-fehlermeldung angepasst
0/1786 tests failed; 376 tests were skipped
Date: Sun Nov 27 20:37:41 2005
Author: dlichteblau
Index: cxml/XMLCONF
diff -u cxml/XMLCONF:1.35 cxml/XMLCONF:1.36
--- cxml/XMLCONF:1.35 Sun Nov 27 20:31:18 2005
+++ cxml/XMLCONF Sun Nov 27 20:37:41 2005
@@ -1194,13 +1194,7 @@
ibm/not-wf/P60/ibm60n01.xml [not validating:] not-wf [validating:] not-wf
ibm/not-wf/P60/ibm60n02.xml [not validating:] not-wf [validating:] not-wf
ibm/not-wf/P60/ibm60n03.xml [not validating:] not-wf [validating:] not-wf
-ibm/not-wf/P60/ibm60n04.xml [not validating:] FAILED:
- For no apparent reason #/< is forbidden in attribute values. You lost -- next time choose SEXPR syntax.
-[
- Tests DefaultDecl with a required field missing. There is no
- attribute value specified after the key word "#FIXED" in the DefaultDecl in
- the AttDef in the AttlistDecl in the DTD.
- ]
+ibm/not-wf/P60/ibm60n04.xml [not validating:] not-wf [validating:] not-wf
ibm/not-wf/P60/ibm60n05.xml [not validating:] not-wf [validating:] not-wf
ibm/not-wf/P60/ibm60n06.xml [not validating:] not-wf [validating:] not-wf
ibm/not-wf/P60/ibm60n07.xml [not validating:] not-wf [validating:] not-wf
@@ -1794,4 +1788,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
-1/1786 tests failed; 376 tests were skipped
\ No newline at end of file
+0/1786 tests failed; 376 tests were skipped
\ No newline at end of file
From dlichteblau at common-lisp.net Sun Nov 27 19:37:43 2005
From: dlichteblau at common-lisp.net (David Lichteblau)
Date: Sun, 27 Nov 2005 20:37:43 +0100 (CET)
Subject: [cxml-cvs] CVS update: cxml/xml/xml-parse.lisp
Message-ID: <20051127193743.8A4CF88554@common-lisp.net>
Update of /project/cxml/cvsroot/cxml/xml
In directory common-lisp.net:/tmp/cvs-serv14037/xml
Modified Files:
xml-parse.lisp
Log Message:
'<'-fehlermeldung angepasst
0/1786 tests failed; 376 tests were skipped
Date: Sun Nov 27 20:37:42 2005
Author: dlichteblau
Index: cxml/xml/xml-parse.lisp
diff -u cxml/xml/xml-parse.lisp:1.39 cxml/xml/xml-parse.lisp:1.40
--- cxml/xml/xml-parse.lisp:1.39 Sun Nov 27 20:31:19 2005
+++ cxml/xml/xml-parse.lisp Sun Nov 27 20:37:42 2005
@@ -1489,11 +1489,7 @@
(t
(wf-error "No PE here.")))))
((and (eq mode :ATT) (rune= c #/<))
- ;; xxx fix error message
- (cerror "Eat them in spite of this."
- "For no apparent reason #\/< is forbidden in attribute values. ~
- You lost -- next time choose SEXPR syntax.")
- (collect c))
+ (wf-error "unexpected #\/<"))
((and canon-space-p (space-rune-p c))
(collect #/space))
((not (data-rune-p c))
From dlichteblau at common-lisp.net Sun Nov 27 20:49:11 2005
From: dlichteblau at common-lisp.net (David Lichteblau)
Date: Sun, 27 Nov 2005 21:49:11 +0100 (CET)
Subject: [cxml-cvs] CVS update: cxml/README.html
Message-ID: <20051127204911.340C388554@common-lisp.net>
Update of /project/cxml/cvsroot/cxml
In directory common-lisp.net:/tmp/cvs-serv19554
Modified Files:
README.html
Log Message:
zeilennummern fuer den ganzen stack ausgeben
Date: Sun Nov 27 21:49:10 2005
Author: dlichteblau
Index: cxml/README.html
diff -u cxml/README.html:1.6 cxml/README.html:1.7
--- cxml/README.html:1.6 Sat Nov 26 22:48:15 2005
+++ cxml/README.html Sun Nov 27 21:49:10 2005
@@ -89,6 +89,11 @@
rel-2005-xx-yy
- Use trivial-gray-streams.
+ -
+ Error handling overhaul: All syntax errors should now be
+ reported as instances of well-formedness-violation. We
+ also print line number information.
+
rel-2005-06-25
* (xmlconf:run-all-tests "/path/to/2001/XML-Test-Suite/xmlconf/")
-0/556 tests failed; 1606 tests were skipped
* (domtest:run-all-tests "/path/to/2001/DOM-Test-Suite/")
-0/449 tests failed; 71 tests were skipped
+
+
+ To compare your results with known output, refer to the files
+ XMLCONF and DOMTEST in the cxml distribution.
+
fixme: Add an explanation of xml/sax-tests here.
Index: cxml/doc/using.html
diff -u cxml/doc/using.html:1.1 cxml/doc/using.html:1.2
--- cxml/doc/using.html:1.1 Sat Jun 25 15:56:54 2005
+++ cxml/doc/using.html Sun Nov 27 21:49:11 2005
@@ -161,6 +161,23 @@
(cxml:parse-file "test.xml" (dom:make-dom-builder))
+
+
Condition class CXML:XML-PARSE-ERROR ()
+ Superclass of all conditions signalled by the CXML parser.
+
+
+
Condition class CXML:WELL-FORMEDNESS-VIOLATION (cxml:xml-parse-error)
+ This condition is signalled for all well-formedness violations.
+ (Note that, when parsing document that is not well-formed in validating
+ mode, the parser might encounter validity errors before detecting
+ well-formedness problems, so also be prepared for validity-error
+ in that situation.)
+
+
+
Condition class CXML:VALIDITY-ERROR (cxml:xml-parse-error)
+ Reports the violation of a validity constraint.
+
+
Serialization
From dlichteblau at common-lisp.net Sun Nov 27 20:49:14 2005
From: dlichteblau at common-lisp.net (David Lichteblau)
Date: Sun, 27 Nov 2005 21:49:14 +0100 (CET)
Subject: [cxml-cvs] CVS update: cxml/xml/xml-parse.lisp
Message-ID: <20051127204914.C60FF88554@common-lisp.net>
Update of /project/cxml/cvsroot/cxml/xml
In directory common-lisp.net:/tmp/cvs-serv19554/xml
Modified Files:
xml-parse.lisp
Log Message:
zeilennummern fuer den ganzen stack ausgeben
Date: Sun Nov 27 21:49:12 2005
Author: dlichteblau
Index: cxml/xml/xml-parse.lisp
diff -u cxml/xml/xml-parse.lisp:1.40 cxml/xml/xml-parse.lisp:1.41
--- cxml/xml/xml-parse.lisp:1.40 Sun Nov 27 20:37:42 2005
+++ cxml/xml/xml-parse.lisp Sun Nov 27 21:49:12 2005
@@ -215,7 +215,8 @@
(id-table (%make-rod-hash-table))
(standalone-p nil)
(entity-resolver nil)
- (disallow-internal-subset nil))
+ (disallow-internal-subset nil)
+ main-zstream)
(defvar *expand-pe-p* nil)
@@ -224,11 +225,19 @@
;;;;
-(defstruct (stream-name (:type list))
+(defstruct (stream-name
+ (:print-function print-stream-name))
entity-name
entity-kind
uri)
+(defun print-stream-name (object stream depth)
+ (declare (ignore depth))
+ (format stream "[~A ~S ~A]"
+ (rod-string (stream-name-entity-name object))
+ (stream-name-entity-kind object)
+ (stream-name-uri object)))
+
(deftype read-element () 'rune)
(defun call-with-open-xstream (fn stream)
@@ -649,20 +658,61 @@
;; would prefer not to document this class.
(define-condition end-of-xstream (well-formedness-violation) ())
-(defun validity-error (x &rest args)
- (error 'validity-error
- :format-control "Document not valid: ~?"
- :format-arguments (list x args)))
-
-(defun wf-error (x &rest args)
- (error 'well-formedness-violation
- :format-control "Document not well-formed: ~?"
- :format-arguments (list x args)))
+(defun describe-xstream (x s)
+ (format s " Line ~D, column ~D in ~A~%"
+ (xstream-line-number x)
+ (xstream-column-number x)
+ (let ((name (xstream-name x)))
+ (cond
+ ((null name)
+ "")
+ ((eq :main (stream-name-entity-kind name))
+ (stream-name-uri name))
+ (t
+ name)))))
+
+(defun %error (class stream message)
+ (let* ((zmain (if *ctx* (main-zstream *ctx*) nil))
+ (zstream (if (zstream-p stream) stream zmain))
+ (xstream (if (xstream-p stream) stream nil))
+ (s (make-string-output-stream)))
+ (write-string "Parse error: " s)
+ (write-line message s)
+ (when xstream
+ (write-line "Location:" s)
+ (describe-xstream xstream s))
+ (when zstream
+ (let ((stack
+ (remove xstream (remove :stop (zstream-input-stack zstream)))))
+ (when stack
+ (write-line "Context:" s)
+ (dolist (x stack)
+ (describe-xstream x s)))))
+ (when (and zmain (not (eq zstream zmain)))
+ (let ((stack
+ (remove xstream (remove :stop (zstream-input-stack zmain)))))
+ (when stack
+ (write-line "Context in main document:" s)
+ (dolist (x stack)
+ (describe-xstream x s)))))
+ (error class
+ :format-control "~A"
+ :format-arguments (list (get-output-stream-string s)))))
+
+(defun validity-error (fmt &rest args)
+ (%error 'validity-error
+ nil
+ (format nil "Document not valid: ~?" fmt args)))
+
+(defun wf-error (stream fmt &rest args)
+ (%error 'well-formedness-violation
+ stream
+ (format nil "Document not well-formed: ~?" fmt args)))
(defun eox (stream &optional x &rest args)
- (error 'end-of-xstream
- :format-control "End of file on ~A~@[: ~?~]"
- :format-arguments (list stream x args)))
+ (%error 'end-of-xstream
+ stream
+ (format nil "End of file~@[: ~?~]" x args)))
(defvar *validate* t)
(defvar *external-subset-p* nil)
@@ -894,7 +944,7 @@
(defun get-entity-definition (entity-name kind dtd)
(unless dtd
- (wf-error "entity not defined: ~A" (rod-string entity-name)))
+ (wf-error nil "entity not defined: ~A" (rod-string entity-name)))
(destructuring-bind (extp &rest def)
(gethash entity-name
(ecase kind
@@ -910,13 +960,14 @@
;; `zstream' is for error messages
(let ((def (get-entity-definition entity-name kind (dtd *ctx*))))
(unless def
- (perror zstream "Entity '~A' is not defined." (rod-string entity-name)))
+ (wf-error zstream "Entity '~A' is not defined." (rod-string entity-name)))
(let (r)
(etypecase def
(internal-entdef
(when (and (standalone-p *ctx*)
(entdef-external-subset-p def))
(wf-error
+ zstream
"entity declared in external subset, but document is standalone"))
(setf r (make-rod-xstream (entdef-value def)))
(setf (xstream-name r)
@@ -925,9 +976,11 @@
:uri nil)))
(external-entdef
(when internalp
- (wf-error "entity not internal: ~A" (rod-string entity-name)))
+ (wf-error zstream
+ "entity not internal: ~A" (rod-string entity-name)))
(when (entdef-ndata def)
- (wf-error "reference to unparsed entity: ~A"
+ (wf-error zstream
+ "reference to unparsed entity: ~A"
(rod-string entity-name)))
(setf r (xstream-open-extid (extid-using-catalog (entdef-extid def))))
(setf (stream-name-entity-name (xstream-name r)) entity-name
@@ -937,7 +990,7 @@
(defun checked-get-entdef (name type)
(let ((def (get-entity-definition name type (dtd *ctx*))))
(unless def
- (wf-error "Entity '~A' is not defined." (rod-string name)))
+ (wf-error nil "Entity '~A' is not defined." (rod-string name)))
def))
(defun xstream-open-extid (extid)
@@ -1205,7 +1258,7 @@
((equalp q '#.(string-rod "FIXED")) :|#FIXED|)
((equalp q '#.(string-rod "PCDATA")) :|#PCDATA|)
(t
- (wf-error "Unknown token: ~S." q)))))
+ (wf-error zinput "Unknown token: ~S." q)))))
((or (rune= c #/U+0020)
(rune= c #/U+0009)
(rune= c #/U+000D)
@@ -1218,7 +1271,7 @@
(t
(values :%))))
(t
- (wf-error "Unexpected character ~S." c))))
+ (wf-error zinput "Unexpected character ~S." c))))
(:DOC
(cond
((rune= c #/&)
@@ -1234,9 +1287,8 @@
(values :CDATA (read-cdata input)))))))))))
(definline check-rune (input actual expected)
- (declare (ignore input))
(unless (eql actual expected)
- (wf-error "expected #/~A but found #/~A"
+ (wf-error input "expected #/~A but found #/~A"
(rune-char expected)
(rune-char actual))))
@@ -1264,9 +1316,12 @@
(cond ((rod= target '#.(string-rod "xml"))
(values :xml-decl (cons target content)))
((rod-equal target '#.(string-rod "XML"))
- (wf-error "You lost -- no XML processing instructions."))
+ (wf-error zinput
+ "You lost -- no XML processing instructions."))
((and sax:*namespace-processing* (position #/: target))
- (wf-error "Processing instruction target ~S is not a valid NcName."
+ (wf-error zinput
+ "Processing instruction target ~S is not a ~
+ valid NcName."
(mu target)))
(t
(values :PI (cons target content))))))
@@ -1275,12 +1330,13 @@
(cond ((name-start-rune-p c)
(read-tag-2 zinput input :etag))
(t
- (wf-error "Expecting name start rune after \"\".")))))
+ (wf-error zinput
+ "Expecting name start rune after \"\".")))))
((name-start-rune-p d)
(unread-rune d input)
(read-tag-2 zinput input :stag))
(t
- (wf-error "Expected '!' or '?' after '<' in DTD.")))))
+ (wf-error zinput "Expected '!' or '?' after '<' in DTD.")))))
(defun read-token-after-| (read-rune input))
(values :ztag (cons name atts)))
(t
- (wf-error "syntax error in read-tag-2.")) )))
+ (wf-error zinput "syntax error in read-tag-2.")) )))
(defun read-attribute (zinput input)
(unless (name-start-rune-p (peek-rune input))
- (wf-error "Expected name."))
+ (wf-error zinput "Expected name."))
;; arg thanks to the post mortem nature of name space declarations,
;; we could only process the attribute values post mortem.
(let ((name (read-name-token input)))
@@ -1386,7 +1442,7 @@
(rune= c #/U+000D))))
(consume-rune input))
(unless (eq (read-rune input) #/=)
- (perror zinput "Expected \"=\"."))
+ (wf-error zinput "Expected \"=\"."))
(while (let ((c (peek-rune input)))
(and (not (eq c :eof))
(or (rune= c #/U+0020)
@@ -1450,7 +1506,7 @@
(%put-unicode-char c collect)))
(t
(unless (name-start-rune-p (peek-rune input))
- (wf-error "Expecting name after &."))
+ (wf-error zinput "Expecting name after &."))
(let ((name (read-name-token input)))
(setf c (read-rune input))
(check-rune input c #/\;)
@@ -1476,7 +1532,7 @@
(when (eq d :eof)
(eox input))
(unless (name-start-rune-p d)
- (wf-error "Expecting name after %.")))
+ (wf-error zinput "Expecting name after %.")))
(let ((name (read-name-token input)))
(setf c (read-rune input))
(check-rune input c #/\;)
@@ -1487,20 +1543,20 @@
(muffle (car (zstream-input-stack zinput))
:eof))))
(t
- (wf-error "No PE here.")))))
+ (wf-error zinput "No PE here.")))))
((and (eq mode :ATT) (rune= c #/<))
- (wf-error "unexpected #\/<"))
+ (wf-error zinput "unexpected #\/<"))
((and canon-space-p (space-rune-p c))
(collect #/space))
((not (data-rune-p c))
- (wf-error "illegal char: ~S." c))
+ (wf-error zinput "illegal char: ~S." c))
(t
(collect c)))))))
(declare (dynamic-extent #'muffle))
(muffle input (or delim
(let ((delim (read-rune input)))
(unless (member delim '(#/\" #/\') :test #'eql)
- (wf-error "invalid attribute delimiter"))
+ (wf-error zinput "invalid attribute delimiter"))
delim))))))
(defun read-character-reference (input)
@@ -1518,7 +1574,7 @@
(when (eql c :eof)
(eox input))
(unless (digit-rune-p c 16)
- (wf-error "garbage in character reference"))
+ (wf-error input "garbage in character reference"))
(prog1
(parse-integer
(with-output-to-string (sink)
@@ -1546,9 +1602,10 @@
:radix 10)
(check-rune input c #/\;)))
(t
- (wf-error "Bad char in numeric character entity.") )))))
+ (wf-error input "Bad char in numeric character entity."))))))
(unless (code-data-char-p res)
(wf-error
+ input
"expansion of numeric character reference (#x~X) is no data char."
res))
res))
@@ -1558,7 +1615,7 @@
(let (name)
(let ((c (peek-rune input)))
(unless (name-start-rune-p c)
- (wf-error "Expecting name after ''"))
+ (wf-error input "Expecting name after ''"))
(setf name (read-name-token input)))
(cond
((member (peek-rune input) '(#/U+0020 #/U+0009 #/U+000A #/U+000D)
@@ -1567,7 +1624,7 @@
(t
(unless (and (eql (read-rune input) #/?)
(eql (read-rune input) #/>))
- (wf-error "malformed processing instruction"))
+ (wf-error input "malformed processing instruction"))
(values name "")))))
(defun read-pi-content (input)
@@ -1581,7 +1638,7 @@
(when (eq d :eof)
(eox input))
(unless (data-rune-p d)
- (wf-error "Illegal char: ~S." d))
+ (wf-error input "Illegal char: ~S." d))
(when (rune= d #/?) (go state-2))
(collect d)
(go state-1)
@@ -1590,7 +1647,7 @@
(when (eq d :eof)
(eox input))
(unless (data-rune-p d)
- (wf-error "Illegal char: ~S." d))
+ (wf-error input "Illegal char: ~S." d))
(when (rune= d #/>) (return))
(when (rune= d #/?)
(collect #/?)
@@ -1608,7 +1665,7 @@
(when (eq d :eof)
(eox input))
(unless (data-rune-p d)
- (wf-error "Illegal char: ~S." d))
+ (wf-error input "Illegal char: ~S." d))
(when (rune= d #/-) (go state-2))
(collect d)
(go state-1)
@@ -1617,7 +1674,7 @@
(when (eq d :eof)
(eox input))
(unless (data-rune-p d)
- (wf-error "Illegal char: ~S." d))
+ (wf-error input "Illegal char: ~S." d))
(when (rune= d #/-) (go state-3))
(collect #/-)
(collect d)
@@ -1627,9 +1684,9 @@
(when (eq d :eof)
(eox input))
(unless (data-rune-p d)
- (wf-error "Illegal char: ~S." d))
+ (wf-error input "Illegal char: ~S." d))
(when (rune= d #/>) (return))
- (wf-error "'--' not allowed in a comment")
+ (wf-error input "'--' not allowed in a comment")
(when (rune= d #/-)
(collect #/-)
(go state-3))
@@ -1649,7 +1706,7 @@
(when (eq d :eof)
(eox input))
(unless (data-rune-p d)
- (wf-error "Illegal char: ~S." d))
+ (wf-error input "Illegal char: ~S." d))
(when (rune= d #/\]) (go state-2))
(collect d)
(go state-1)
@@ -1658,7 +1715,7 @@
(when (eq d :eof)
(eox input))
(unless (data-rune-p d)
- (wf-error "Illegal char: ~S." d))
+ (wf-error input "Illegal char: ~S." d))
(when (rune= d #/\]) (go state-3))
(collect #/\])
(collect d)
@@ -1668,7 +1725,7 @@
(when (eq d :eof)
(eox input))
(unless (data-rune-p d)
- (wf-error "Illegal char: ~S." d))
+ (wf-error input "Illegal char: ~S." d))
(when (rune= d #/>)
(return))
(when (rune= d #/\])
@@ -1708,7 +1765,7 @@
(defun expect (input category)
(multiple-value-bind (cat sem) (read-token input)
(unless (eq cat category)
- (wf-error "Expected ~S saw ~S [~S]" category cat sem))
+ (wf-error input "Expected ~S saw ~S [~S]" category cat sem))
(values cat sem)))
(defun consume-token (input)
@@ -1735,7 +1792,7 @@
(defun p/name (input)
(let ((result (p/nmtoken input)))
(unless (name-start-rune-p (elt result 0))
- (wf-error "Expected name."))
+ (wf-error input "Expected name."))
result))
(defun p/attlist-decl (input)
@@ -1758,7 +1815,8 @@
(:>
(return))
(otherwise
- (wf-error "Expected either another AttDef or end of \")
(when *validate*
@@ -2185,7 +2243,7 @@
((rod= sem '#.(string-rod "ANY"))
:ANY)
((not recursivep)
- (wf-error "invalid content spec"))
+ (wf-error input "invalid content spec"))
(t
sem)))
((eq cat :\#PCDATA)
@@ -2215,7 +2273,7 @@
(validity-error "(06) Proper Group/PE Nesting")))
res)
(t
- (wf-error "p/cspec - ~s / ~s" cat sem)))))))
+ (wf-error input "p/cspec - ~s / ~s" cat sem)))))))
(cond ((eq (peek-token input) :?) (consume-token input) (list '? term))
((eq (peek-token input) :+) (consume-token input) (list '+ term))
((eq (peek-token input) :*) (consume-token input) (list '* term))
@@ -2302,7 +2360,7 @@
(rod= sem '#.(string-rod "IGNORE")))
(p/ignore-sect input stream))
(t
- (wf-error "Expected INCLUDE or IGNORE after \"" sem)
- (wf-error "']]>' not allowed in CharData"))
+ (wf-error input "']]>' not allowed in CharData"))
(validate-characters *ctx* sem)
(sax:characters (handler *ctx*) sem)
(p/content input))
@@ -2698,7 +2747,7 @@
(internal-entdef (p/content input))
(external-entdef (p/ext-parsed-ent input)))
(unless (eq (peek-token input) :eof)
- (wf-error "Trailing garbage. - ~S"
+ (wf-error input "Trailing garbage. - ~S"
(peek-token input))))))
(p/content input))))
((:= (length (cdar atts)) 1)
(every (lambda (x)
(or (rune<= #/a x #/z)
@@ -2768,7 +2817,7 @@
(rune= x #/:)
(rune= x #/-)))
(cdar atts)))
- (wf-error "Bad XML version number: ~S." (rod-string (cdar atts))))
+ (wf-error i"Bad XML version number: ~S." (rod-string (cdar atts))))
(setf (xml-header-version res) (rod-string (cdar atts)))
(pop atts)
(when (eq (caar atts) (intern-name '#.(string-rod "encoding")))
@@ -2785,13 +2834,13 @@
(or (rune<= #/a x #/z)
(rune<= #/A x #/Z)))
(aref (cdar atts) 0)))
- (wf-error "Bad XML encoding name: ~S." (rod-string (cdar atts))))
+ (wf-error i "Bad XML encoding name: ~S." (rod-string (cdar atts))))
(setf (xml-header-encoding res) (rod-string (cdar atts)))
(pop atts))
(when (eq (caar atts) (intern-name '#.(string-rod "standalone")))
(unless (or (rod= (cdar atts) '#.(string-rod "yes"))
(rod= (cdar atts) '#.(string-rod "no")))
- (wf-error "XMLDecl's 'standalone' attribute must be exactly \"yes\" or \"no\" and not ~S."
+ (wf-error i "XMLDecl's 'standalone' attribute must be exactly \"yes\" or \"no\" and not ~S."
(rod-string (cdar atts))))
(setf (xml-header-standalone-p res)
(if (rod-equal '#.(string-rod "yes") (cdar atts))
@@ -2799,7 +2848,7 @@
:no))
(pop atts))
(when atts
- (wf-error "Garbage in XMLDecl: ~A" (rod-string content)))
+ (wf-error i "Garbage in XMLDecl: ~A" (rod-string content)))
res))
(defun parse-text-decl (content)
@@ -2808,7 +2857,7 @@
(z (make-zstream :input-stack (list i)))
(atts (read-attribute-list z i t)))
(unless (eq (peek-rune i) :eof)
- (wf-error "Garbage at end of TextDecl"))
+ (wf-error i "Garbage at end of TextDecl"))
;; versioninfo optional
;; encodingdecl muss da sein
;; dann ende
@@ -2823,11 +2872,11 @@
(rune= x #/:)
(rune= x #/-)))
(cdar atts)))
- (wf-error "Bad XML version number: ~S." (rod-string (cdar atts))))
+ (wf-error i "Bad XML version number: ~S." (rod-string (cdar atts))))
(setf (xml-header-version res) (rod-string (cdar atts)))
(pop atts))
(unless (eq (caar atts) (intern-name '#.(string-rod "encoding")))
- (wf-error "TextDecl needs encoding."))
+ (wf-error i "TextDecl needs encoding."))
(unless (and (>= (length (cdar atts)) 1)
(every (lambda (x)
(or (rune<= #/a x #/z)
@@ -2842,11 +2891,11 @@
(rune<= #/A x #/Z)
(rune<= #/0 x #/9)))
(aref (cdar atts) 0)))
- (wf-error "Bad XML encoding name: ~S." (rod-string (cdar atts))))
+ (wf-error i "Bad XML encoding name: ~S." (rod-string (cdar atts))))
(setf (xml-header-encoding res) (rod-string (cdar atts)))
(pop atts)
(when atts
- (wf-error "Garbage in TextDecl: ~A" (rod-string content)))
+ (wf-error i "Garbage in TextDecl: ~A" (rod-string content)))
res))
;;;; ---------------------------------------------------------------------------
@@ -2966,13 +3015,14 @@
:type type))))))
(defun parse-xstream (xstream handler &rest 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))))
+ (let ((*ctx* nil))
+ (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 xstream "~A" c)))))
(defun parse-file (filename handler &rest args)
(with-open-xfile (input filename)
@@ -3079,7 +3129,7 @@
(eql (stream-name-entity-kind (xstream-name x))
(stream-name-entity-kind (xstream-name new-xstream)))))
(zstream-input-stack zstream))
- (wf-error "Infinite recursion.")))
+ (wf-error zstream "Infinite recursion.")))
(push new-xstream (zstream-input-stack zstream))
zstream)
@@ -3200,7 +3250,7 @@
(not (or (%rune= rune #/U+0009)
(%rune= rune #/U+000a)
(%rune= rune #/U+000d))))
- (wf-error "code point invalid: ~A" rune))
+ (wf-error input "code point invalid: ~A" rune))
(or (%rune= rune #/<) (%rune= rune #/&)))
input
source start end)
@@ -3223,9 +3273,9 @@
(defun internal-entity-expansion (name)
(let ((def (get-entity-definition name :general (dtd *ctx*))))
(unless def
- (wf-error "Entity '~A' is not defined." (rod-string name)))
+ (wf-error nil "Entity '~A' is not defined." (rod-string name)))
(unless (typep def 'internal-entdef)
- (wf-error "Entity '~A' is not an internal entity." name))
+ (wf-error nil "Entity '~A' is not an internal entity." name))
(or (entdef-expansion def)
(setf (entdef-expansion def) (find-internal-entity-expansion name)))))
@@ -3247,7 +3297,7 @@
(%put-unicode-char c collect)))
(t
(unless (name-start-rune-p c)
- (wf-error "Expecting name after &."))
+ (wf-error zinput "Expecting name after &."))
(let ((name (read-name-token input)))
(setf c (read-rune input))
(check-rune input c #/\;)
@@ -3256,11 +3306,11 @@
(lambda (zinput)
(muffle (car (zstream-input-stack zinput)))))))))
((rune= c #/<)
- (wf-error "unexpected #\/<"))
+ (wf-error zinput "unexpected #\/<"))
((space-rune-p c)
(collect #/space))
((not (data-rune-p c))
- (wf-error "illegal char: ~S." c))
+ (wf-error zinput "illegal char: ~S." c))
(t
(collect c)))))))
(declare (dynamic-extent #'muffle))
@@ -3284,7 +3334,8 @@
(internal-entdef (p/content input))
(external-entdef (p/ext-parsed-ent input)))
(unless (eq (peek-token input) :eof)
- (wf-error "Trailing garbage. - ~S" (peek-token input))))))))
+ (wf-error input "Trailing garbage. - ~S"
+ (peek-token input))))))))
nil)))
(defun read-att-value-2 (input)
@@ -3292,8 +3343,9 @@
(when (eql delim :eof)
(eox input))
(unless (member delim '(#/\" #/\') :test #'eql)
- (wf-error "Bad attribute value delimiter ~S, must be either #\\\" or #\\\'."
- (rune-char delim)))
+ (wf-error input
+ "Bad attribute value delimiter ~S, must be either #\\\" or #\\\'."
+ (rune-char delim)))
(with-rune-collector-4 (collect)
(loop
(let ((c (read-rune input)))
@@ -3302,7 +3354,7 @@
((rune= c delim)
(return))
((rune= c #/<)
- (wf-error "'<' not allowed in attribute values"))
+ (wf-error input "'<' not allowed in attribute values"))
((rune= #/& c)
(multiple-value-bind (kind sem) (read-entity-like input)
(ecase kind
@@ -3359,7 +3411,7 @@
(defun find-namespace-binding (prefix)
(cdr (or (assoc (or prefix #"") (namespace-bindings *ctx*) :test #'rod=)
- (wf-error "Undeclared namespace prefix: ~A" (rod-string prefix)))))
+ (wf-error nil "Undeclared namespace prefix: ~A" (rod-string prefix)))))
;; FIXME: Should probably be refactored by adding :start and :end to rod=/rod-equal
(defun rod-starts-with (prefix rod)
@@ -3410,26 +3462,32 @@
(cond
((and (rod= prefix #"xml")
(not (rod= uri #"http://www.w3.org/XML/1998/namespace")))
- (wf-error "Attempt to rebind the prefix \"xml\" to ~S." (mu uri)))
+ (wf-error nil
+ "Attempt to rebind the prefix \"xml\" to ~S." (mu uri)))
((and (rod= uri #"http://www.w3.org/XML/1998/namespace")
(not (rod= prefix #"xml")))
- (wf-error "The namespace ~
+ (wf-error nil
+ "The namespace ~
URI \"http://www.w3.org/XML/1998/namespace\" may not ~
be bound to the prefix ~S, only \"xml\" is legal."
(mu prefix)))
((and (rod= prefix #"xmlns")
(rod= uri #"http://www.w3.org/2000/xmlns/"))
- (wf-error "Attempt to bind the prefix \"xmlns\" to its predefined ~
+ (wf-error nil
+ "Attempt to bind the prefix \"xmlns\" to its predefined ~
URI \"http://www.w3.org/2000/xmlns/\", which is ~
forbidden for no good reason."))
((rod= prefix #"xmlns")
- (wf-error "Attempt to bind the prefix \"xmlns\" to the URI ~S, ~
+ (wf-error nil
+ "Attempt to bind the prefix \"xmlns\" to the URI ~S, ~
but it may not be declared." (mu uri)))
((rod= uri #"http://www.w3.org/2000/xmlns/")
- (wf-error "The namespace URI \"http://www.w3.org/2000/xmlns/\" may ~
+ (wf-error nil
+ "The namespace URI \"http://www.w3.org/2000/xmlns/\" may ~
not be bound to prefix ~S (or any other)." (mu prefix)))
((and (rod= uri #"") prefix)
- (wf-error "Only the default namespace (the one without a prefix) ~
+ (wf-error nil
+ "Only the default namespace (the one without a prefix) ~
may be bound to an empty namespace URI, thus ~
undeclaring it."))
(t
@@ -3476,7 +3534,8 @@
(rod= (sax:attribute-local-name attr-1)
(sax:attribute-local-name attr-2))))
(cdr sublist)))
- (wf-error "Multiple definitions of attribute ~S in namespace ~S."
+ (wf-error nil
+ "Multiple definitions of attribute ~S in namespace ~S."
(mu (sax:attribute-local-name attr-1))
(mu (sax:attribute-namespace-uri attr-1))))))))
From dlichteblau at common-lisp.net Sun Nov 27 20:59:01 2005
From: dlichteblau at common-lisp.net (David Lichteblau)
Date: Sun, 27 Nov 2005 21:59:01 +0100 (CET)
Subject: [cxml-cvs] CVS update: cxml/runes/encodings.lisp
Message-ID: <20051127205901.ADC1E88554@common-lisp.net>
Update of /project/cxml/cvsroot/cxml/runes
In directory common-lisp.net:/tmp/cvs-serv19629/runes
Modified Files:
encodings.lisp
Log Message:
name-hashtable in den context gezogen, das war wohl kaum thread-safe so.
allerdings keine ahnung wofuer sie ueberhaupt da ist.
Date: Sun Nov 27 21:59:00 2005
Author: dlichteblau
Index: cxml/runes/encodings.lisp
diff -u cxml/runes/encodings.lisp:1.4 cxml/runes/encodings.lisp:1.5
--- cxml/runes/encodings.lisp:1.4 Sun Nov 27 19:20:10 2005
+++ cxml/runes/encodings.lisp Sun Nov 27 21:59:00 2005
@@ -124,7 +124,7 @@
;; Zeichen abwarten und nachgucken, dass nicht etwa die andere
;; Haelfte fehlt!
(let ((x (logior (ash hi 8) lo)))
- (when (or (eql x #xFFFE) (eql x #/U+FFFF))
+ (when (or (eql x #xFFFE) (eql x #xFFFF))
(xerror "not a valid code point: #x~X" x))
(setf (aref out wptr) x))
(setf wptr (%+ 1 wptr))))
@@ -147,7 +147,7 @@
;; Zeichen abwarten und nachgucken, dass nicht etwa die andere
;; Haelfte fehlt!
(let ((x (logior (ash hi 8) lo)))
- (when (or (eql x #xFFFE) (eql x #/U+FFFF))
+ (when (or (eql x #xFFFE) (eql x #xFFFF))
(xerror "not a valid code point: #x~X" x))
(setf (aref out wptr) x))
(setf wptr (%+ 1 wptr))))
@@ -169,7 +169,7 @@
(xerror "surrogate encoded in UTF-8: #x~X." x))
(cond ((or (%> x #x10FFFF)
(eql x #xFFFE)
- (eql x #/U+FFFF))
+ (eql x #xFFFF))
(xerror "not a valid code point: #x~X" x))
((%> x #xFFFF)
(setf (aref out (%+ 0 wptr)) (%+ #xD7C0 (ash x -10))
From dlichteblau at common-lisp.net Sun Nov 27 20:59:02 2005
From: dlichteblau at common-lisp.net (David Lichteblau)
Date: Sun, 27 Nov 2005 21:59:02 +0100 (CET)
Subject: [cxml-cvs] CVS update: cxml/xml/xml-parse.lisp
Message-ID: <20051127205902.3A4EE8855E@common-lisp.net>
Update of /project/cxml/cvsroot/cxml/xml
In directory common-lisp.net:/tmp/cvs-serv19629/xml
Modified Files:
xml-parse.lisp
Log Message:
name-hashtable in den context gezogen, das war wohl kaum thread-safe so.
allerdings keine ahnung wofuer sie ueberhaupt da ist.
Date: Sun Nov 27 21:59:01 2005
Author: dlichteblau
Index: cxml/xml/xml-parse.lisp
diff -u cxml/xml/xml-parse.lisp:1.41 cxml/xml/xml-parse.lisp:1.42
--- cxml/xml/xml-parse.lisp:1.41 Sun Nov 27 21:49:12 2005
+++ cxml/xml/xml-parse.lisp Sun Nov 27 21:59:00 2005
@@ -213,6 +213,8 @@
model-stack
(referenced-notations '())
(id-table (%make-rod-hash-table))
+ ;; FIXME: Wofuer ist name-hashtable da? Will man das wissen?
+ (name-hashtable (make-rod-hashtable :size 2000))
(standalone-p nil)
(entity-resolver nil)
(disallow-internal-subset nil)
@@ -479,14 +481,12 @@
(defun (setf rod-hash-get) (new-value hashtable rod &optional (start 0) (end (length rod)))
(rod-hash-set new-value hashtable rod start end))
-(defparameter *name-hashtable* (make-rod-hashtable :size 2000))
-
(defun intern-name (rod &optional (start 0) (end (length rod)))
- (multiple-value-bind (value successp key) (rod-hash-get *name-hashtable* rod start end)
+ (multiple-value-bind (value successp key) (rod-hash-get (name-hashtable *ctx*) rod start end)
(declare (ignore value))
(if successp
key
- (nth-value 1 (rod-hash-set t *name-hashtable* rod start end)))))
+ (nth-value 1 (rod-hash-set t (name-hashtable *ctx*) rod start end)))))
;;;; ---------------------------------------------------------------------------
;;;;
From dlichteblau at common-lisp.net Sun Nov 27 21:02:59 2005
From: dlichteblau at common-lisp.net (David Lichteblau)
Date: Sun, 27 Nov 2005 22:02:59 +0100 (CET)
Subject: [cxml-cvs] CVS update: cxml/XMLCONF
Message-ID: <20051127210259.663C788554@common-lisp.net>
Update of /project/cxml/cvsroot/cxml
In directory common-lisp.net:/tmp/cvs-serv20698
Modified Files:
XMLCONF
Log Message:
namespace-tests an
Date: Sun Nov 27 22:02:57 2005
Author: dlichteblau
Index: cxml/XMLCONF
diff -u cxml/XMLCONF:1.36 cxml/XMLCONF:1.37
--- cxml/XMLCONF:1.36 Sun Nov 27 20:37:41 2005
+++ cxml/XMLCONF Sun Nov 27 22:02:53 2005
@@ -1788,4 +1788,84 @@
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
-0/1786 tests failed; 376 tests were skipped
\ No newline at end of file
+eduni/namespaces/1.0/001.xml [not validating:] input [validating:] input
+eduni/namespaces/1.0/002.xml [not validating:] input [validating:] input
+eduni/namespaces/1.0/003.xml [not validating:] input [validating:] input
+eduni/namespaces/1.0/007.xml [not validating:] input [validating:] input
+eduni/namespaces/1.0/008.xml [not validating:] input [validating:] input
+eduni/namespaces/1.0/009.xml [not validating:] not-wf [validating:] not-wf
+eduni/namespaces/1.0/010.xml [not validating:] not-wf [validating:] not-wf
+eduni/namespaces/1.0/011.xml [not validating:] not-wf [validating:] not-wf
+eduni/namespaces/1.0/012.xml [not validating:] FAILED:
+ well-formedness violation not detected
+[
+Namespace inequality test: equal after attribute value normalization
+]
+eduni/namespaces/1.0/013.xml [not validating:] FAILED:
+ #(98 58 97 116 116 114) fell through ETYPECASE expression.
+ Wanted one of (STRING SIMPLE-STRING).
+[
+Bad QName syntax: multiple colons
+]
+eduni/namespaces/1.0/014.xml [not validating:] FAILED:
+ invalid array index 0 for #() (should be nonnegative and <0)
+[
+Bad QName syntax: colon at end
+]
+eduni/namespaces/1.0/015.xml [not validating:] FAILED:
+ well-formedness violation not detected
+[
+Bad QName syntax: colon at start
+]
+eduni/namespaces/1.0/016.xml [not validating:] FAILED:
+ invalid array index 0 for #() (should be nonnegative and <0)
+[
+Bad QName syntax: xmlns:
+]
+eduni/namespaces/1.0/017.xml [not validating:] input [validating:] invalid
+eduni/namespaces/1.0/018.xml [not validating:] input [validating:] invalid
+eduni/namespaces/1.0/019.xml [not validating:] input [validating:] invalid
+eduni/namespaces/1.0/020.xml [not validating:] input [validating:] invalid
+eduni/namespaces/1.0/021.xml [not validating:] input [validating:] invalid
+eduni/namespaces/1.0/022.xml [not validating:] input [validating:] invalid
+eduni/namespaces/1.0/023.xml [not validating:] not-wf [validating:] invalid
+eduni/namespaces/1.0/024.xml [not validating:] input [validating:] invalid
+eduni/namespaces/1.0/025.xml [not validating:] not-wf [validating:] invalid
+eduni/namespaces/1.0/026.xml [not validating:] not-wf [validating:] invalid
+eduni/namespaces/1.0/027.xml [not validating:] input [validating:] invalid
+eduni/namespaces/1.0/028.xml [not validating:] input [validating:] invalid
+eduni/namespaces/1.0/029.xml [not validating:] not-wf [validating:] invalid
+eduni/namespaces/1.0/030.xml [not validating:] not-wf [validating:] invalid
+eduni/namespaces/1.0/031.xml [not validating:] not-wf [validating:] invalid
+eduni/namespaces/1.0/032.xml [not validating:] not-wf [validating:] invalid
+eduni/namespaces/1.0/033.xml [not validating:] not-wf [validating:] invalid
+eduni/namespaces/1.0/034.xml [not validating:] input [validating:] invalid
+eduni/namespaces/1.0/035.xml [not validating:] not-wf [validating:] invalid
+eduni/namespaces/1.0/036.xml [not validating:] not-wf [validating:] invalid
+eduni/namespaces/1.0/037.xml [not validating:] input [validating:] invalid
+eduni/namespaces/1.0/038.xml [not validating:] input [validating:] invalid
+eduni/namespaces/1.0/039.xml [not validating:] input [validating:] invalid
+eduni/namespaces/1.0/040.xml [not validating:] input [validating:] invalid
+eduni/namespaces/1.0/041.xml [not validating:] input [validating:] invalid
+eduni/namespaces/1.0/042.xml [not validating:] not-wf [validating:] not-wf
+eduni/namespaces/1.0/043.xml [not validating:] FAILED:
+ well-formedness violation not detected
+[
+Colon in entity name
+]
+eduni/namespaces/1.0/044.xml [not validating:] FAILED:
+ well-formedness violation not detected
+[
+Colon in entity name
+]
+eduni/namespaces/1.0/045.xml [not validating:] input [validating:] FAILED:
+ validity error not detected
+[
+Colon in ID attribute name
+]
+eduni/namespaces/1.0/046.xml [not validating:] input [validating:] FAILED:
+ validity error not detected
+[
+Colon in ID attribute name
+]
+9/1829 tests failed; 333 tests were skipped
\ No newline at end of file
From dlichteblau at common-lisp.net Sun Nov 27 21:02:59 2005
From: dlichteblau at common-lisp.net (David Lichteblau)
Date: Sun, 27 Nov 2005 22:02:59 +0100 (CET)
Subject: [cxml-cvs] CVS update: cxml/test/xmlconf.lisp
Message-ID: <20051127210259.C4A278855E@common-lisp.net>
Update of /project/cxml/cvsroot/cxml/test
In directory common-lisp.net:/tmp/cvs-serv20698/test
Modified Files:
xmlconf.lisp
Log Message:
namespace-tests an
Date: Sun Nov 27 22:02:58 2005
Author: dlichteblau
Index: cxml/test/xmlconf.lisp
diff -u cxml/test/xmlconf.lisp:1.6 cxml/test/xmlconf.lisp:1.7
--- cxml/test/xmlconf.lisp:1.6 Sun Nov 27 01:58:06 2005
+++ cxml/test/xmlconf.lisp Sun Nov 27 22:02:58 2005
@@ -18,7 +18,8 @@
((not (and (let ((version (get-attribute test "RECOMMENDATION")))
(cond
((or (equal version "") ;XXX
- (equal version "XML1.0"))
+ (equal version "XML1.0")
+ (equal version "NS1.0"))
(cond
((equal (get-attribute test "NAMESPACE") "no")
(format t "~A: test applies to parsers without namespace support, skipping~%"
From dlichteblau at common-lisp.net Mon Nov 28 22:22:53 2005
From: dlichteblau at common-lisp.net (David Lichteblau)
Date: Mon, 28 Nov 2005 23:22:53 +0100 (CET)
Subject: [cxml-cvs] CVS update: cxml/README.html
Message-ID: <20051128222253.187E9880D7@common-lisp.net>
Update of /project/cxml/cvsroot/cxml
In directory common-lisp.net:/tmp/cvs-serv3876
Modified Files:
README.html
Log Message:
kommentaraenderungen
Date: Mon Nov 28 23:22:50 2005
Author: dlichteblau
Index: cxml/README.html
diff -u cxml/README.html:1.7 cxml/README.html:1.8
--- cxml/README.html:1.7 Sun Nov 27 21:49:10 2005
+++ cxml/README.html Mon Nov 28 23:22:49 2005
@@ -65,8 +65,10 @@