-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=...". ]

XMLCONF

@@ -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:
+sun/not-wf/dtd07.xml [not-wf?] not-wf
-  well-formedness violation not detected
-[
-    Text declarations (which optionally begin any external entity)
-    are required to have "encoding=...". ]
 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

xml/xml-name-rune-p.lisp

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

xml/xml-parse.lisp

@@ -670,10 +670,10 @@
 ;;;;  DTD
 ;;;;
 
-(define-condition parse-error (simple-error) ())
+(define-condition xml-parse-error (simple-error) ())
-(define-condition well-formedness-violation (parse-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,28 +2743,24 @@
 (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)
+(defun parse-xml-decl (content)
-  ;; --> xml-header
-  ;;(make-xml-header))
   (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"))))
+    (unless (eq (caar atts) (intern-name '#.(string-rod "version")))
-               sd-ok-p)
+      (wf-error "XMLDecl needs version."))
-      (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)
@@ -2775,9 +2771,9 @@
 			      (rune= x #/:)
 			      (rune= x #/-)))
 			(cdar atts)))
-        (error "Bad XML version number: ~S." (rod-string (cdar atts))))
+      (wf-error "Bad XML version number: ~S." (rod-string (cdar atts))))
     (setf (xml-header-version res) (rod-string (cdar atts)))
-      (pop atts))
+    (pop atts)
     (when (eq (caar atts) (intern-name '#.(string-rod "encoding")))
       (unless (and (>= (length (cdar atts)) 1)
                    (every (lambda (x)
@@ -2793,14 +2789,13 @@
                           (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: ~
+        (wf-error "XMLDecl's 'standalone' attribute must be exactly \"yes\" or \"no\" and not ~S."
-                XML PI'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))
@@ -2808,10 +2803,53 @@
 		:no))
       (pop atts))
     (when atts
-      (error "XML designers decided to disallow future extensions to the set ~
+      (wf-error "Garbage in XMLDecl: ~A" (rod-string content)))
-              of allowed XML PI's attributes -- you might have lost big on ~S (~S)"
+    res))
-             (rod-string content) sd-ok-p
+
-             ))
+(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))
 
 ;;;; ---------------------------------------------------------------------------