From: Chris Hanson <org/chris-hanson/cph>
Date: Fri, 25 Jul 2003 20:37:17 +0000 (+0000)
Subject: Fix some bugs related to processing of external entity references.
X-Git-Tag: 20090517-FFI~1857
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=9671b2db64944ceaa051289365ffd40ca8a1f53f;p=mit-scheme.git

Fix some bugs related to processing of external entity references.
---

diff --git a/v7/src/xml/xml-parser.scm b/v7/src/xml/xml-parser.scm
index cc66ec6c7..4d5396e14 100644
--- a/v7/src/xml/xml-parser.scm
+++ b/v7/src/xml/xml-parser.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: xml-parser.scm,v 1.24 2003/03/02 03:49:46 cph Exp $
+$Id: xml-parser.scm,v 1.25 2003/07/25 20:37:17 cph Exp $
 
 Copyright 2001,2002,2003 Massachusetts Institute of Technology
 
@@ -680,14 +680,15 @@ USA.
     entity))
 
 (define (dereference-parameter-entity name)
-  (let ((elements
+  (let ((value
 	 (and (not (eq? *parameter-entities* 'STOP))
 	      (let ((entity (find-parameter-entity name)))
 		(and entity
 		     (xml-parameter-!entity-value entity))))))
-    (if (and (string? (car elements))
-	     (null? (cdr elements)))
-	(car elements)
+    (if (and (pair? value)
+	     (string? (car value))
+	     (null? (cdr value)))
+	(car value)
 	(begin
 	  (set! *parameter-entities* 'STOP)
 	  (set! *general-entities* 'STOP)
@@ -715,15 +716,22 @@ USA.
 	      (begin
 		(if (xml-unparsed-!entity? entity)
 		    (perror p "Reference to unparsed entity" name))
-		(let ((elements (xml-!entity-value entity)))
-		  (if (and (string? (car elements))
-			   (null? (cdr elements)))
+		(let ((value (xml-!entity-value entity)))
+		  (if (and (pair? value)
+			   (string? (car value))
+			   (null? (cdr value)))
 		      (if expand?
-			  (expand-entity-value-string name (car elements) p)
-			  (vector (car elements)))
+			  (expand-entity-value-string name (car value) p)
+			  (vector (car value)))
 		      (begin
 			(if (or *standalone?* *internal-dtd?*)
-			    (perror p "Reference to partially-defined entity"
+			    (perror p
+				    (string-append
+				     "Reference to "
+				     (if (xml-external-id? value)
+					 "externally"
+					 "partially")
+				     "-defined entity")
 				    name))
 			(vector (make-xml-entity-ref name))))))
 	      (begin