From: Chris Hanson <org/chris-hanson/cph>
Date: Fri, 25 Jul 2003 23:05:57 +0000 (+0000)
Subject: Fix bug in handling of external general entities.
X-Git-Tag: 20090517-FFI~1854
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=3bf0bc0b1307fa9e085f0df3d44245fbac787993;p=mit-scheme.git

Fix bug in handling of external general entities.
---

diff --git a/v7/src/xml/xml-parser.scm b/v7/src/xml/xml-parser.scm
index 4d5396e14..419154903 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.25 2003/07/25 20:37:17 cph Exp $
+$Id: xml-parser.scm,v 1.26 2003/07/25 23:05:57 cph Exp $
 
 Copyright 2001,2002,2003 Massachusetts Institute of Technology
 
@@ -439,7 +439,7 @@ USA.
   (*parser
    (alt parse-char-reference
 	(with-pointer p
-	  (transform (lambda (v) (dereference-entity (vector-ref v 0) #t p))
+	  (transform (lambda (v) (dereference-entity (vector-ref v 0) #f p))
 	    parse-entity-reference-name)))))
 
 (define parse-reference-deferred
@@ -585,7 +585,7 @@ USA.
 				       (cons (get-output-string port) result)))
 				  (let ((value
 					 (vector-ref
-					  (dereference-entity name #f p)
+					  (dereference-entity name #t p)
 					  0)))
 				    (if (string? value)
 					(expand-entity-value name p
@@ -705,7 +705,7 @@ USA.
 
 ;;;; General parsed entities
 
-(define (dereference-entity name expand? p)
+(define (dereference-entity name in-attribute? p)
   (if (eq? *general-entities* 'STOP)
       (vector (make-xml-entity-ref name))
       (begin
@@ -717,23 +717,25 @@ USA.
 		(if (xml-unparsed-!entity? entity)
 		    (perror p "Reference to unparsed entity" name))
 		(let ((value (xml-!entity-value entity)))
-		  (if (and (pair? value)
-			   (string? (car value))
-			   (null? (cdr value)))
-		      (if expand?
-			  (expand-entity-value-string name (car value) p)
-			  (vector (car value)))
-		      (begin
-			(if (or *standalone?* *internal-dtd?*)
-			    (perror p
-				    (string-append
-				     "Reference to "
-				     (if (xml-external-id? value)
-					 "externally"
-					 "partially")
-				     "-defined entity")
-				    name))
-			(vector (make-xml-entity-ref name))))))
+		  (cond ((and (pair? value)
+			      (string? (car value))
+			      (null? (cdr value)))
+			 (if in-attribute?
+			     (vector (car value))
+			     (expand-entity-value-string name (car value) p)))
+			((xml-external-id? value)
+			 (begin
+			   (if in-attribute?
+			       (perror
+				p
+				"Reference to external entity in attribute"
+				name))
+			   (vector (make-xml-entity-ref name))))
+			(else
+			 (if (or *standalone?* *internal-dtd?*)
+			     (perror p "Reference to partially-defined entity"
+				     name))
+			 (vector (make-xml-entity-ref name))))))
 	      (begin
 		(if (or *standalone?* *internal-dtd?*)
 		    (perror p "Reference to undefined entity" name))