From ca330b9df36dd68b1f0fdbee1daf8c066d32053a Mon Sep 17 00:00:00 2001 From: "Arthur A. Gleckler" Date: Sat, 2 Apr 2011 23:56:59 -0700 Subject: [PATCH] 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. --- src/xml/xml-names.scm | 29 ++++++++++++++--------------- 1 file changed, 14 insertions(+), 15 deletions(-) diff --git a/src/xml/xml-names.scm b/src/xml/xml-names.scm index 9f8fab1b0..a3065b0a3 100644 --- a/src/xml/xml-names.scm +++ b/src/xml/xml-names.scm @@ -28,21 +28,20 @@ USA. (declare (usual-integrations)) (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 -- 2.25.1