Fixed bug that caused (load-option 'xml) to fail with this error

message:

  ;The object #[uri 11 ""], passed as an argument to make-xml-name, is not in the correct range.

The bug was caused by the fix to `->absolute-uri' in change
562020fdf80823b5825ad901e208b10a4d3b058b.

diff --git a/src/xml/xml-names.scm b/src/xml/xml-names.scm
index 9f8fab1b04180516605a9b6da280f3e08ca9e371..a3065b0a343864f4bfb29b4c72779fe98f5d4784 100644 (file)
--- a/src/xml/xml-names.scm
+++ b/src/xml/xml-names.scm
@@ -28,21 +28,20 @@ USA.
 (declare (usual-integrations))
 \f
 (define (make-xml-name name #!optional uri)
-  (let ((name-symbol (make-xml-name-symbol name))
-       (uri
-        (if (default-object? uri)
-            (null-xml-namespace-uri)
-            (->absolute-uri uri 'MAKE-XML-NAME))))
-    (if (null-xml-namespace-uri? uri)
-       name-symbol
-       (begin
-         (guarantee-xml-qname name-symbol 'MAKE-XML-NAME)
-         (if (not (case (xml-qname-prefix name-symbol)
-                    ((xml) (uri=? uri xml-uri))
-                    ((xmlns) (uri=? uri xmlns-uri))
-                    (else #t)))
-             (error:bad-range-argument uri 'MAKE-XML-NAME))
-         (%make-xml-name name-symbol uri)))))
+  (let ((name-symbol (make-xml-name-symbol name)))
+    (cond ((default-object? uri)
+          name-symbol)
+         ((null-xml-namespace-uri? uri)
+          name-symbol)
+         (else
+          (let ((uri (->absolute-uri uri 'MAKE-XML-NAME)))
+            (guarantee-xml-qname name-symbol 'MAKE-XML-NAME)
+            (if (not (case (xml-qname-prefix name-symbol)
+                       ((xml) (uri=? uri xml-uri))
+                       ((xmlns) (uri=? uri xmlns-uri))
+                       (else #t)))
+                (error:bad-range-argument uri 'MAKE-XML-NAME))
+            (%make-xml-name name-symbol uri))))))
 
 ;;; EXPANDED-NAMES should be a key-weak hash table, but that has an
 ;;; effect only if the other two hash tables are datum-weak, because