From: Chris Hanson <org/chris-hanson/cph>
Date: Wed, 20 Aug 2003 17:22:54 +0000 (+0000)
Subject: Fix minor bug in syntax of processing instructions.
X-Git-Tag: 20090517-FFI~1823
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=f88d6609f8fdcc22328c6b18cf01cfc6ff74df6e;p=mit-scheme.git

Fix minor bug in syntax of processing instructions.
---

diff --git a/v7/src/xml/xml-parser.scm b/v7/src/xml/xml-parser.scm
index 0ce443b9b..62bf256cd 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.34 2003/08/05 16:51:42 cph Exp $
+$Id: xml-parser.scm,v 1.35 2003/08/20 17:22:54 cph Exp $
 
 Copyright 2001,2002,2003 Massachusetts Institute of Technology
 
@@ -557,22 +557,26 @@ USA.
 	 (transform
 	     (lambda (v)
 	       (let ((name (vector-ref v 0))
-		     (text (vector-ref v 1)))
+		     (text
+		      (and (fix:= (vector-length v) 2)
+			   (vector-ref v 1))))
 		 (if (string-ci=? (symbol-name name) "xml")
 		     (perror p "Reserved XML processor name" name))
-		 (let ((entry (assq name *pi-handlers*)))
-		   (if entry
-		       (let ((content ((cadr entry) text)))
-			 (if (not (list-of-type? content valid-content?))
-			     (perror p
-				     "Illegal output from XML processor"
-				     name))
-			 (list->vector content))
-		       (vector
-			(make-xml-processing-instructions name text))))))
+		 (if text
+		     (let ((entry (assq name *pi-handlers*)))
+		       (if entry
+			   (let ((content ((cadr entry) text)))
+			     (if (not (list-of-type? content valid-content?))
+				 (perror p
+					 "Illegal output from XML processor"
+					 name))
+			     (list->vector content))
+			   (vector
+			    (make-xml-processing-instructions name text))))
+		     (vector))))
 	   (sbracket description start end
 	     parse-pi-name
-	     parse-body)))))))
+	     (? (seq S parse-body)))))))))
 
 (define parse-pi:misc
   (pi-parser