OSCL/CXML
2
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

fast durchweg s/:name/:nmtoken/, denn meist ist letzteres gemeint

Browse Source 
-oasis/p71fail2.xml [not-wf?] FAILED:
-  well-formedness violation not detected
-[
-     Entity name is a Name, not an NMToken
-    ]
-oasis/p72fail4.xml [not-wf?] FAILED:
-  well-formedness violation not detected
-[
-     Entity name is a name, not an NMToken
-    ]
This commit is contained in:
dlichteblau
2005-11-27 00:26:59 +00:00
parent 4d538921b4
commit 2954764732
2 changed files with 29 additions and 31 deletions
Download Patch File Download Diff File Expand all files Collapse all files

14
XMLCONF
View File

@ -847,21 +847,13 @@ oasis/p69fail2.xml [not-wf?] not-wf
oasis/p69fail3.xml [not-wf?] not-wf oasis/p69fail3.xml [not-wf?] not-wf
oasis/p70fail1.xml [not-wf?] not-wf oasis/p70fail1.xml [not-wf?] not-wf
oasis/p71fail1.xml [not-wf?] not-wf oasis/p71fail1.xml [not-wf?] not-wf
oasis/p71fail2.xml [not-wf?] FAILED: oasis/p71fail2.xml [not-wf?] not-wf
well-formedness violation not detected
[
Entity name is a Name, not an NMToken
]
oasis/p71fail3.xml [not-wf?] not-wf oasis/p71fail3.xml [not-wf?] not-wf
oasis/p71fail4.xml [not-wf?] not-wf oasis/p71fail4.xml [not-wf?] not-wf
oasis/p72fail1.xml [not-wf?] not-wf oasis/p72fail1.xml [not-wf?] not-wf
oasis/p72fail2.xml [not-wf?] not-wf oasis/p72fail2.xml [not-wf?] not-wf
oasis/p72fail3.xml [not-wf?] not-wf oasis/p72fail3.xml [not-wf?] not-wf
oasis/p72fail4.xml [not-wf?] FAILED: oasis/p72fail4.xml [not-wf?] not-wf
well-formedness violation not detected
[
Entity name is a name, not an NMToken
]
oasis/p73fail1.xml [not-wf?] not-wf oasis/p73fail1.xml [not-wf?] not-wf
oasis/p73fail2.xml [not-wf?] not-wf oasis/p73fail2.xml [not-wf?] not-wf
oasis/p73fail3.xml [not-wf?] not-wf oasis/p73fail3.xml [not-wf?] not-wf
@ -1845,4 +1837,4 @@ ibm/valid/P86/ibm86v01.xml [not validating:] input [validating:] input
ibm/valid/P87/ibm87v01.xml [not validating:] input [validating:] input ibm/valid/P87/ibm87v01.xml [not validating:] input [validating:] input
ibm/valid/P88/ibm88v01.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 ibm/valid/P89/ibm89v01.xml [not validating:] input [validating:] input
12/1786 tests failed; 376 tests were skipped 10/1786 tests failed; 376 tests were skipped

46
xml/xml-parse.lisp
View File

@ -77,7 +77,7 @@
;; *data-behaviour* = :DTD ;; *data-behaviour* = :DTD
;; ;;
;; :name <interned-rod> ;; :nmtoken <interned-rod>
;; :#required ;; :#required
;; :#implied ;; :#implied
;; :#fixed ;; :#fixed
@ -652,7 +652,7 @@
(defun wf-error (x &rest args) (defun wf-error (x &rest args)
(error 'well-formedness-violation (error 'well-formedness-violation
:format-control "Validity constraint violated: ~@?" :format-control "Well-formedness violated: ~@?"
:format-arguments (list x args))) :format-arguments (list x args)))
(defvar *validate* t) (defvar *validate* t)
@ -1178,7 +1178,7 @@
((rune= #/\+ c) :\+) ((rune= #/\+ c) :\+)
((name-rune-p c) ((name-rune-p c)
(unread-rune c input) (unread-rune c input)
(values :name (read-name-token input))) (values :nmtoken (read-name-token input)))
((rune= #/# c) ((rune= #/# c)
(let ((q (read-name-token input))) (let ((q (read-name-token input)))
(cond ((equalp q '#.(string-rod "REQUIRED")) :|#REQUIRED|) (cond ((equalp q '#.(string-rod "REQUIRED")) :|#REQUIRED|)
@ -1728,15 +1728,21 @@
(while (eq (peek-token input) :S) (while (eq (peek-token input) :S)
(consume-token input))) (consume-token input)))
(defun p/nmtoken (input)
(nth-value 1 (expect input :nmtoken)))
(defun p/name (input) (defun p/name (input)
(nth-value 1 (expect input :name))) (let ((result (p/nmtoken input)))
(unless (name-start-rune-p (elt result 0))
(wf-error "Expected name."))
result))
(defun p/attlist-decl (input) (defun p/attlist-decl (input)
;; [52] AttlistDecl ::= '<!ATTLIST' S Name (S AttDef)* S? '>' ;; [52] AttlistDecl ::= '<!ATTLIST' S Name (S AttDef)* S? '>'
(let (elm-name) (let (elm-name)
(expect input :|<!ATTLIST|) (expect input :|<!ATTLIST|)
(p/S input) (p/S input)
(setf elm-name (p/name input)) (setf elm-name (p/nmtoken input))
(loop (loop
(let ((tok (read-token input))) (let ((tok (read-token input)))
(case tok (case tok
@ -1757,7 +1763,7 @@
(defun p/attdef (input) (defun p/attdef (input)
;; [53] AttDef ::= Name S AttType S DefaultDecl ;; [53] AttDef ::= Name S AttType S DefaultDecl
(let (name type default) (let (name type default)
(setf name (p/name input)) (setf name (p/nmtoken input))
(p/S input) (p/S input)
(setf type (p/att-type input)) (setf type (p/att-type input))
(p/S input) (p/S input)
@ -1799,7 +1805,7 @@
;; /* VC: Notation Attributes */ ;; /* VC: Notation Attributes */
;; [59] Enumeration ::= '(' S? Nmtoken (S? '|' S? Nmtoken)* S? ')' /* VC: Enumeration */ ;; [59] Enumeration ::= '(' S? Nmtoken (S? '|' S? Nmtoken)* S? ')' /* VC: Enumeration */
(multiple-value-bind (cat sem) (read-token input) (multiple-value-bind (cat sem) (read-token input)
(cond ((eq cat :name) (cond ((eq cat :nmtoken)
(cond ((equalp sem '#.(string-rod "CDATA")) :CDATA) (cond ((equalp sem '#.(string-rod "CDATA")) :CDATA)
((equalp sem '#.(string-rod "ID")) :ID) ((equalp sem '#.(string-rod "ID")) :ID)
((equalp sem '#.(string-rod "IDREF")) :IDREFS) ((equalp sem '#.(string-rod "IDREF")) :IDREFS)
@ -1812,7 +1818,7 @@
(let (names) (let (names)
(p/S input) (p/S input)
(expect input :\() (expect input :\()
(setf names (p/list input #'p/name :\| )) (setf names (p/list input #'p/nmtoken :\| ))
(expect input :\)) (expect input :\))
(when *validate* (when *validate*
(setf (referenced-notations *ctx*) (setf (referenced-notations *ctx*)
@ -1824,7 +1830,7 @@
;; XXX Die Nmtoken-Syntax pruefen wir derzeit nur beim Validieren. ;; XXX Die Nmtoken-Syntax pruefen wir derzeit nur beim Validieren.
(let (names) (let (names)
;;(expect input :\() ;;(expect input :\()
(setf names (p/list input #'p/name :\| )) (setf names (p/list input #'p/nmtoken :\| ))
(expect input :\)) (expect input :\))
(cons :ENUMERATION names))) (cons :ENUMERATION names)))
(t (t
@ -1901,7 +1907,7 @@
(multiple-value-bind (cat sem) (peek-token input) (multiple-value-bind (cat sem) (peek-token input)
(cond ((member cat '(:\" :\')) (cond ((member cat '(:\" :\'))
(make-internal-entdef (p/entity-value input))) (make-internal-entdef (p/entity-value input)))
((and (eq cat :name) ((and (eq cat :nmtoken)
(or (equalp sem '#.(string-rod "SYSTEM")) (or (equalp sem '#.(string-rod "SYSTEM"))
(equalp sem '#.(string-rod "PUBLIC")))) (equalp sem '#.(string-rod "PUBLIC"))))
(let (extid ndata) (let (extid ndata)
@ -1909,12 +1915,12 @@
(when (eq kind :general) ;NDATA allowed at all? (when (eq kind :general) ;NDATA allowed at all?
(cond ((eq (peek-token input) :S) (cond ((eq (peek-token input) :S)
(p/S? input) (p/S? input)
(when (and (eq (peek-token input) :name) (when (and (eq (peek-token input) :nmtoken)
(equalp (nth-value 1 (peek-token input)) (equalp (nth-value 1 (peek-token input))
'#.(string-rod "NDATA"))) '#.(string-rod "NDATA")))
(consume-token input) (consume-token input)
(p/S input) (p/S input)
(setf ndata (p/name input)) (setf ndata (p/nmtoken input))
(when *validate* (when *validate*
(push ndata (referenced-notations *ctx*))))))) (push ndata (referenced-notations *ctx*)))))))
(make-external-entdef extid ndata))) (make-external-entdef extid ndata)))
@ -1940,10 +1946,10 @@
(defun p/external-id (input &optional (public-only-ok-p nil)) (defun p/external-id (input &optional (public-only-ok-p nil))
;; xxx public-only-ok-p ;; xxx public-only-ok-p
(multiple-value-bind (cat sem) (read-token input) (multiple-value-bind (cat sem) (read-token input)
(cond ((and (eq cat :name) (equalp sem '#.(string-rod "SYSTEM"))) (cond ((and (eq cat :nmtoken) (equalp sem '#.(string-rod "SYSTEM")))
(p/S input) (p/S input)
(make-extid nil (p/system-literal input))) (make-extid nil (p/system-literal input)))
((and (eq cat :name) (equalp sem '#.(string-rod "PUBLIC"))) ((and (eq cat :nmtoken) (equalp sem '#.(string-rod "PUBLIC")))
(let (pub sys) (let (pub sys)
(p/S input) (p/S input)
(setf pub (p/pubid-literal input)) (setf pub (p/pubid-literal input))
@ -2015,7 +2021,7 @@
(let (name content) (let (name content)
(expect input :|<!ELEMENT|) (expect input :|<!ELEMENT|)
(p/S input) (p/S input)
(setf name (p/name input)) (setf name (p/nmtoken input))
(p/S input) (p/S input)
(setf content (normalize-mixed-cspec (p/cspec input))) (setf content (normalize-mixed-cspec (p/cspec input)))
(unless (legal-content-model-p content *validate*) (unless (legal-content-model-p content *validate*)
@ -2171,7 +2177,7 @@
(let ((term (let ((term
(let ((names nil) op-cat op res stream) (let ((names nil) op-cat op res stream)
(multiple-value-bind (cat sem) (peek-token input) (multiple-value-bind (cat sem) (peek-token input)
(cond ((eq cat :name) (cond ((eq cat :nmtoken)
(consume-token input) (consume-token input)
(cond ((rod= sem '#.(string-rod "EMPTY")) (cond ((rod= sem '#.(string-rod "EMPTY"))
:EMPTY) :EMPTY)
@ -2245,7 +2251,7 @@
(let (name id) (let (name id)
(expect input :|<!NOTATION|) (expect input :|<!NOTATION|)
(p/S input) (p/S input)
(setf name (p/name input)) (setf name (p/nmtoken input))
(p/S input) (p/S input)
(setf id (p/external-id input t)) (setf id (p/external-id input t))
(p/S? input) (p/S? input)
@ -2286,10 +2292,10 @@
(let ((stream (car (zstream-input-stack input)))) (let ((stream (car (zstream-input-stack input))))
(p/S? input) (p/S? input)
(multiple-value-bind (cat sem) (read-token input) (multiple-value-bind (cat sem) (read-token input)
(cond ((and (eq cat :name) (cond ((and (eq cat :nmtoken)
(rod= sem '#.(string-rod "INCLUDE"))) (rod= sem '#.(string-rod "INCLUDE")))
(p/include-sect input stream)) (p/include-sect input stream))
((and (eq cat :name) ((and (eq cat :nmtoken)
(rod= sem '#.(string-rod "IGNORE"))) (rod= sem '#.(string-rod "IGNORE")))
(p/ignore-sect input stream)) (p/ignore-sect input stream))
(t (t
@ -2425,7 +2431,7 @@
name extid) name extid)
(expect input :|<!DOCTYPE|) (expect input :|<!DOCTYPE|)
(p/S input) (p/S input)
(setq name (p/name input)) (setq name (p/nmtoken input))
(when *validate* (when *validate*
(setf (model-stack *ctx*) (list (make-root-model name)))) (setf (model-stack *ctx*) (list (make-root-model name))))
(when (eq (peek-token input) :S) (when (eq (peek-token input) :S)