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

-sun/not-wf/dtd07.xml [not-wf?] FAILED:

Browse Source 
-  well-formedness violation not detected
-[
-    Text declarations (which optionally begin any external entity)
-    are required to have "encoding=...". ]
This commit is contained in:
dlichteblau
2005-11-26 23:25:28 +00:00
parent f3be0c3585
commit 6ffd9568c1
3 changed files with 83 additions and 49 deletions
Download Patch File Download Diff File Expand all files Collapse all files

8
XMLCONF
View File

@ -493,11 +493,7 @@ sun/not-wf/dtd02.xml [not-wf?] not-wf
sun/not-wf/dtd03.xml [not-wf?] not-wf
sun/not-wf/dtd04.xml [not-wf?] not-wf
sun/not-wf/dtd05.xml [not-wf?] not-wf
sun/not-wf/dtd07.xml [not-wf?] FAILED:
well-formedness violation not detected
[
Text declarations (which optionally begin any external entity)
are required to have "encoding=...". ]
sun/not-wf/dtd07.xml [not-wf?] not-wf
sun/not-wf/element00.xml [not-wf?] not-wf
sun/not-wf/element01.xml [not-wf?] not-wf
sun/not-wf/element02.xml [not-wf?] not-wf
@ -2385,4 +2381,4 @@ ibm/valid/P86/ibm86v01.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/P89/ibm89v01.xml [not validating:] input [validating:] input
121/1786 tests failed; 376 tests were skipped
120/1786 tests failed; 376 tests were skipped

8
xml/xml-name-rune-p.lisp
View File

@ -11,7 +11,7 @@
(compile
nil
'(lambda ()
(let ((.max. #xD800))
(let ((+max+ #xD800))
(labels
((name-start-rune-p (rune)
(or (letter-rune-p rune)
@ -207,7 +207,7 @@
(predicate-to-bv (p)
(let ((r (make-array .max. :element-type 'bit :initial-element 0)))
(let ((r (make-array +max+ :element-type 'bit :initial-element 0)))
(dotimes (i #x10000 r)
(when (funcall p i)
(setf (aref r i) 1))))) )
@ -215,13 +215,13 @@
`(progn
(DEFINLINE NAME-RUNE-P (RUNE)
(SETF RUNE (RUNE-CODE RUNE))
(AND (<= 0 RUNE ,.max.)
(AND (<= 0 RUNE ,+max+)
(LOCALLY (DECLARE (OPTIMIZE (SAFETY 0) (SPEED 3)))
(= 1 (SBIT ',(predicate-to-bv #'name-rune-p)
(THE FIXNUM RUNE))))))
(DEFINLINE NAME-START-RUNE-P (RUNE)
(SETF RUNE (RUNE-CODE RUNE))
(AND (<= 0 RUNE ,.MAX.)
(AND (<= 0 RUNE ,+MAX+)
(LOCALLY (DECLARE (OPTIMIZE (SAFETY 0) (SPEED 3)))
(= 1 (SBIT ',(predicate-to-bv #'name-start-rune-p)
(THE FIXNUM RUNE)))))))) ))))

116
xml/xml-parse.lisp
View File

@ -670,10 +670,10 @@
;;;; DTD
;;;;
(define-condition parse-error (simple-error) ())
(define-condition well-formedness-violation (parse-error) ())
(define-condition xml-parse-error (simple-error) ())
(define-condition well-formedness-violation (xml-parse-error) ())
(define-condition end-of-xstream (well-formedness-violation) ())
(define-condition validity-error (parse-error) ())
(define-condition validity-error (xml-parse-error) ())
(defun validity-error (x &rest args)
(error 'validity-error
@ -2420,7 +2420,7 @@
(defun p/ext-subset (input)
(cond ((eq (peek-token input) :xml-pi)
(let ((hd (parse-xml-pi (cdr (nth-value 1 (peek-token input))) nil)))
(let ((hd (parse-text-decl (cdr (nth-value 1 (peek-token input))))))
(setup-encoding input hd))
(consume-token input)))
(set-full-speed input)
@ -2569,7 +2569,7 @@
(let ((*data-behaviour* :DTD))
;; optional XMLDecl?
(cond ((eq (peek-token input) :xml-pi)
(let ((hd (parse-xml-pi (cdr (nth-value 1 (peek-token input))) t)))
(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))
(read-token input)))
@ -2743,41 +2743,37 @@
(defun p/ext-parsed-ent (input)
;; [78] extParsedEnt ::= '<?xml' VersionInfo? EncodingDecl S? '?>' content
(when (eq (peek-token input) :xml-pi)
(let ((hd (parse-xml-pi (cdr (nth-value 1 (peek-token input))) nil)))
(let ((hd (parse-text-decl (cdr (nth-value 1 (peek-token input))))))
(setup-encoding input hd))
(consume-token input) )
(consume-token input))
(set-full-speed input)
(p/content input))
(defun parse-xml-pi (content sd-ok-p)
;; --> xml-header
;;(make-xml-header))
(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
(unless (eq (peek-rune i) :eof)
(error "Garbage at end of XML PI."))
(error "Garbage at end of XMLDecl."))
;; versioninfo muss da sein
;; dann ? encodingdecl
;; dann ? sddecl
;; dann ende
(when (and (not (eq (caar atts) (intern-name '#.(string-rod "version"))))
sd-ok-p)
(error "XML PI needs version."))
(when (eq (caar atts) (intern-name '#.(string-rod "version")))
(unless (and (>= (length (cdar atts)) 1)
(every (lambda (x)
(or (rune<= #/a x #/z)
(rune<= #/A x #/Z)
(rune<= #/0 x #/9)
(rune= x #/_)
(rune= x #/.)
(rune= x #/:)
(rune= x #/-)))
(cdar atts)))
(error "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 "version")))
(wf-error "XMLDecl needs version."))
(unless (and (>= (length (cdar atts)) 1)
(every (lambda (x)
(or (rune<= #/a x #/z)
(rune<= #/A x #/Z)
(rune<= #/0 x #/9)
(rune= x #/_)
(rune= x #/.)
(rune= x #/:)
(rune= x #/-)))
(cdar atts)))
(wf-error "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")))
(unless (and (>= (length (cdar atts)) 1)
(every (lambda (x)
@ -2793,25 +2789,67 @@
(rune<= #/A x #/Z)
(rune<= #/0 x #/9)))
(aref (cdar atts) 0)))
(error "Bad XML encoding name: ~S." (rod-string (cdar atts))))
(wf-error "Bad XML encoding name: ~S." (rod-string (cdar atts))))
(setf (xml-header-encoding res) (rod-string (cdar atts)))
(pop atts))
(when (and sd-ok-p (eq (caar atts) (intern-name '#.(string-rod "standalone"))))
(when (eq (caar atts) (intern-name '#.(string-rod "standalone")))
(unless (or (rod= (cdar atts) '#.(string-rod "yes"))
(rod= (cdar atts) '#.(string-rod "no")))
(error "Hypersensitivity pitfall: ~
XML PI's 'standalone' attribute must be exactly \"yes\" or \"no\" and not ~S."
(wf-error "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))
:yes
:no))
(if (rod-equal '#.(string-rod "yes") (cdar atts))
:yes
:no))
(pop atts))
(when atts
(error "XML designers decided to disallow future extensions to the set ~
of allowed XML PI's attributes -- you might have lost big on ~S (~S)"
(rod-string content) sd-ok-p
))
(wf-error "Garbage in XMLDecl: ~A" (rod-string content)))
res))
(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
(unless (eq (peek-rune i) :eof)
(error "Garbage at end of TextDecl"))
;; versioninfo optional
;; encodingdecl muss da sein
;; dann ende
(when (eq (caar atts) (intern-name '#.(string-rod "version")))
(unless (and (>= (length (cdar atts)) 1)
(every (lambda (x)
(or (rune<= #/a x #/z)
(rune<= #/A x #/Z)
(rune<= #/0 x #/9)
(rune= x #/_)
(rune= x #/.)
(rune= x #/:)
(rune= x #/-)))
(cdar atts)))
(wf-error "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."))
(unless (and (>= (length (cdar atts)) 1)
(every (lambda (x)
(or (rune<= #/a x #/z)
(rune<= #/A x #/Z)
(rune<= #/0 x #/9)
(rune= x #/_)
(rune= x #/.)
(rune= x #/-)))
(cdar atts))
((lambda (x)
(or (rune<= #/a x #/z)
(rune<= #/A x #/Z)
(rune<= #/0 x #/9)))
(aref (cdar atts) 0)))
(wf-error "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)))
res))
;;;; ---------------------------------------------------------------------------