[WFC: No External Entity References]

XMLCONF

@@ -79,22 +79,12 @@ xmltest/not-wf/sa/078.xml [not validating:] not-wf [validating:] not-wf
 xmltest/not-wf/sa/079.xml [not validating:] not-wf [validating:] not-wf
 xmltest/not-wf/sa/080.xml [not validating:] not-wf [validating:] not-wf
 xmltest/not-wf/sa/081.xml [not validating:] not-wf [validating:] not-wf
-xmltest/not-wf/sa/082.xml [not validating:] FAILED:
+xmltest/not-wf/sa/082.xml [not validating:] not-wf [validating:] not-wf
-  Error opening #P"/home/david/2001/XML-Test-Suite/xmlconf/xmltest/not-wf/sa/nul", No such file or directory.
-[
-    This tests the  WFC,
-    since the entity is referred to within an attribute.  ]
 xmltest/not-wf/sa/083.xml [not validating:] FAILED:
   Error opening #P"/home/david/2001/XML-Test-Suite/xmlconf/xmltest/not-wf/sa/nul", No such file or directory.
 [
     Undefined NOTATION n. ]
-xmltest/not-wf/sa/084.xml [not validating:] FAILED:
+xmltest/not-wf/sa/084.xml [not validating:] not-wf [validating:] not-wf
-  Error opening #P"/home/david/2001/XML-Test-Suite/xmlconf/xmltest/not-wf/sa/nul", No such file or directory.
-[
-    Tests the  WFC by referring to an
-    unparsed entity.  (This precedes the error of not declaring
-    that entity's notation, which may be detected any time before
-    the DTD parsing is completed.) ]
 xmltest/not-wf/sa/085.xml [not validating:] not-wf [validating:] not-wf
 xmltest/not-wf/sa/086.xml [not validating:] not-wf [validating:] not-wf
 xmltest/not-wf/sa/087.xml [not validating:] not-wf [validating:] not-wf
@@ -1934,4 +1924,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
-30/1786 tests failed; 376 tests were skipped
+28/1786 tests failed; 376 tests were skipped

xml/xml-parse.lisp

@@ -642,9 +642,13 @@
 
 (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 (xml-parse-error) ())
 
+;; We make some effort to signal end of file as a special condition, but we
+;; don't actually try very hard.  Not sure whether we should.  Right now I
+;; 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: ~?"
@@ -901,13 +905,11 @@
                       (rod-string entity-name)))
     def))
 
-(defun entity->xstream (entity-name kind &optional zstream)
+(defun entity->xstream (zstream entity-name kind &optional internalp)
   ;; `zstream' is for error messages
   (let ((def (get-entity-definition entity-name kind (dtd *ctx*))))
     (unless def
-      (if zstream
+      (perror zstream "Entity '~A' is not defined." (rod-string entity-name)))
-          (perror zstream "Entity '~A' is not defined." (rod-string entity-name))
-        (wf-error "Entity '~A' is not defined." (rod-string entity-name))))
     (let (r)
       (etypecase def
         (internal-entdef
@@ -917,6 +919,8 @@
                              :entity-kind kind
                              :uri nil)))
         (external-entdef
+         (when internalp
+	   (wf-error "entity not internal: ~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
                (stream-name-entity-kind (xstream-name r)) kind)))
@@ -941,9 +945,9 @@
                   :name (make-stream-name :uri sysid)
                   :initial-speed 1)))
 
-(defun call-with-entity-expansion-as-stream (zstream cont name kind)
+(defun call-with-entity-expansion-as-stream (zstream cont name kind internalp)
-  ;; `zstream' is for error messages -- we need something better!
+  ;; `zstream' is for error messages
-  (let ((in (entity->xstream name kind zstream)))
+  (let ((in (entity->xstream zstream name kind internalp)))
     (unwind-protect
         (funcall cont in)
       (close-xstream in))))
@@ -1234,7 +1238,7 @@
     (check-rune input #/\; (read-rune input))
     (cond (*expand-pe-p*
            ;; no external entities here!
-           (let ((i2 (entity->xstream nam :parameter)))
+           (let ((i2 (entity->xstream  zinput nam :parameter)))
              (zstream-push i2 zinput))
            (values :S nil) ;space before inserted PE expansion.
            )
@@ -1443,7 +1447,8 @@
                                        zinput name :general
                                        (lambda (zinput)
                                          (muffle (car (zstream-input-stack zinput))
-                                                 :eof))))
+                                                 :eof))
+				       t))
                                      (:ENT
                                       ;; bypass, but never the less we
                                       ;; need to check for legal
@@ -3052,10 +3057,8 @@
   (push new-xstream (zstream-input-stack zstream))
   zstream)
 
-(defun recurse-on-entity (zstream name kind continuation)
+(defun recurse-on-entity (zstream name kind continuation &optional internalp)
   (assert (not (zstream-token-category zstream)))
-  ;;(sleep .2)
-  ;;(warn "~S / ~S[~S]." (zstream-input-stack zstream) (mu name) kind)
   (call-with-entity-expansion-as-stream
    zstream
    (lambda (new-xstream)
@@ -3069,7 +3072,9 @@
        (assert (eq (pop (zstream-input-stack zstream)) :stop))
        (setf (zstream-token-category zstream) nil)
        '(consume-token zstream)) )
-   name kind))
+   name
+   kind
+   internalp))
 
 #||
 (defmacro read-data-until* ((predicate input res res-start res-end) &body body)