[cxml-cvs] CVS update: cxml/xml/xml-parse.lisp

[David Lichteblau]

Update of /project/cxml/cvsroot/cxml/xml
In directory common-lisp.net:/tmp/cvs-serv12653/xml

Modified Files:
	xml-parse.lisp 
Log Message:
eof im pi content korrekt pruefen

Date: Sun Nov 27 13:06:29 2005
Author: dlichteblau

Index: cxml/xml/xml-parse.lisp
diff -u cxml/xml/xml-parse.lisp:1.21 cxml/xml/xml-parse.lisp:1.22
--- cxml/xml/xml-parse.lisp:1.21	Sun Nov 27 12:55:59 2005
+++ cxml/xml/xml-parse.lisp	Sun Nov 27 13:06:29 2005
@@ -647,14 +647,19 @@
 
 (defun validity-error (x &rest args)
   (error 'validity-error
-         :format-control "Validity constraint violated: ~@?"
+         :format-control "Validity constraint violated: ~?"
          :format-arguments (list x args)))
 
 (defun wf-error (x &rest args)
   (error 'well-formedness-violation
-         :format-control "Well-formedness violated: ~@?"
+         :format-control "Well-formedness violated: ~?"
          :format-arguments (list x 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)))
+
 (defvar *validate* t)
 (defvar *markup-declaration-external-p* nil)
 
@@ -1230,7 +1235,7 @@
 (defun read-token-after-|<| (zinput input)
   (let ((d (read-rune input)))
     (cond ((eq d :eof)
-           (wf-error "EOF after '<'"))
+           (eox input "EOF after '<'"))
           ((rune= #/! d)
            (read-token-after-|<!| input))
           ((rune= #/? d)
@@ -1259,7 +1264,7 @@
 (defun read-token-after-|<!| (input)
   (let ((d (read-rune input)))
     (cond ((eq d :eof)
-           (wf-error "EOF after \"<!\"."))
+           (eox input "EOF after \"<!\"."))
           ((name-start-rune-p d)
            (unread-rune d input)
            (let ((name (read-name-token input)))
@@ -1311,7 +1316,7 @@
    The initial #\\& is considered to be consumed already."
   (let ((c (peek-rune input)))
     (cond ((eq c :eof)
-           (wf-error "EOF after '&'"))
+           (eox input "EOF after '&'"))
           ((rune= c #/#)
            (values :NUMERIC (read-numeric-entity input)))
           (t
@@ -1411,7 +1416,7 @@
                    (cond ((eql delim c)
                           (return))
                          ((eq c :eof)
-                          (wf-error "EOF"))
+                          (eox input "EOF"))
                          ((rune= c #/&)
                           (setf c (peek-rune input))
                           (cond ((rune= c #/#)
@@ -1526,33 +1531,34 @@
 	  (wf-error "malformed processing instruction"))
 	(values name "")))))
 
-(defun read-pi-content (input &aux d)
+(defun read-pi-content (input)
   (read-S? input)
-  (with-rune-collector (collect)
-    (block nil
-      (tagbody
-       state-1
-        (setf d (read-rune input))
-	(unless d
-	  (error 'end-of-xstream))
-        (unless (data-rune-p d)
-          (wf-error "Illegal char: ~S." d))
-        (when (rune= d #/?) (go state-2))
-        (collect d)
-        (go state-1)
-       state-2 ;; #/? seen
-        (setf d (read-rune input))
-	(unless d
-	  (error 'end-of-xstream))
-        (unless (data-rune-p d)
-          (wf-error "Illegal char: ~S." d))
-        (when (rune= d #/>) (return))
-        (when (rune= d #/?)
-          (collect #/?)
-          (go state-2))
-        (collect #/?)
-        (collect d)
-        (go state-1)))))
+  (let (d)
+    (with-rune-collector (collect)
+      (block nil
+	(tagbody
+	 state-1
+	  (setf d (read-rune input))
+	  (when (eq d :eof)
+	    (eox input))
+	  (unless (data-rune-p d)
+	    (wf-error "Illegal char: ~S." d))
+	  (when (rune= d #/?) (go state-2))
+	  (collect d)
+	  (go state-1)
+	 state-2 ;; #/? seen
+	  (setf d (read-rune input))
+	  (when (eq d :eof)
+	    (eox input))
+	  (unless (data-rune-p d)
+	    (wf-error "Illegal char: ~S." d))
+	  (when (rune= d #/>) (return))
+	  (when (rune= d #/?)
+	    (collect #/?)
+	    (go state-2))
+	  (collect #/?)
+	  (collect d)
+	  (go state-1))))))
 
 (defun read-comment-content (input &aux d)
   (with-rune-collector (collect)
@@ -1922,7 +1928,7 @@
                (loop
                  (let ((c (read-rune (car (zstream-input-stack input)))))
                    (cond ((eq c :eof)
-                          (wf-error "EOF in system literal."))
+                          (eox input "EOF in system literal."))
                          ((rune= c delim)
                           (return))
                          (t
@@ -2275,7 +2281,7 @@
           ((= level -1))
         (declare (type fixnum level))
         (cond ((eq c1 :eof)
-               (wf-error "EOF in <![IGNORE ... >")))
+               (eox input "EOF in <![IGNORE ... >")))
         (cond ((and (rune= c3 #/<) (rune= c2 #/!) (rune= c1 #/\[))
                (incf level)))
         (cond ((and (rune= c3 #/\]) (rune= c2 #/\]) (rune= c1 #/>))
@@ -3230,7 +3236,7 @@
       (loop
         (let ((c (read-rune input)))
           (cond ((eq c :eof)
-                 (wf-error "EOF"))
+                 (eox input "EOF"))
                 ((rune= c delim)
                  (return))
                 ((rune= c #/<)