From 194a220a35ca5f3028d0ea79cc4bd21404a230e9 Mon Sep 17 00:00:00 2001 From: dlichteblau Date: Sun, 4 Dec 2005 23:20:22 +0000 Subject: [PATCH] auch qname "xmlns" hat einen namespace, falls sax:*sowieso* an ist. und im dom-builder nicht den namen des doctypes pruefen --- DOMTEST | 9 ++------- dom/dom-builder.lisp | 3 +-- dom/dom-impl.lisp | 12 +++++++++--- xml/xml-parse.lisp | 22 +++++++++++++--------- 4 files changed, 25 insertions(+), 21 deletions(-) diff --git a/DOMTEST b/DOMTEST index 061aa1f..fa03c69 100644 --- a/DOMTEST +++ b/DOMTEST @@ -586,7 +586,6 @@ implementationAttribute signed not supported, skipping test 556/808 documentcreateattributeNS05.xml 557/808 documentcreateattributeNS06.xml 558/808 documentcreateattributeNS07.xml -TEST FAILED: expected exception NAMESPACE_ERR 559/808 documentcreateelementNS01.xml 560/808 documentcreateelementNS02.xml 561/808 documentcreateelementNS05.xml @@ -671,7 +670,6 @@ TEST FAILED: The assertion DOMTEST-TESTS::|success| failed. 613/808 elementhasattribute03.xml 614/808 elementhasattribute04.xml 615/808 elementhasattributens01.xml -TEST FAILED: The assertion DOMTEST-TESTS::|state| failed. 616/808 elementhasattributens02.xml 617/808 elementhasattributens03.xml 618/808 elementremoveattributens01.xml @@ -690,7 +688,6 @@ implementationAttribute expandEntityReferences not supported, skipping test 628/808 elementsetattributens04.xml 629/808 elementsetattributens05.xml 630/808 elementsetattributens08.xml -TEST FAILED: expected exception NAMESPACE_ERR 631/808 elementsetattributensurinull.xml 632/808 getAttributeNS01.xml 633/808 getAttributeNS02.xml @@ -807,8 +804,6 @@ TEST FAILED: There is no applicable method for the generic function (NIL). 719/808 namednodemapremovenameditemns03.xml 720/808 namednodemapremovenameditemns04.xml -TEST FAILED: NOT_FOUND_ERR (8): -#(120 109 108 110 115) not found in # 721/808 namednodemapremovenameditemns05.xml 722/808 namednodemapremovenameditemns06.xml 723/808 namednodemapremovenameditemns07.xml @@ -885,6 +880,7 @@ TEST FAILED: The assertion (DOMTEST::EQUALSP DOMTEST-TESTS::|newAttrName| 775/808 prefix07.xml 776/808 prefix08.xml 777/808 prefix09.xml +TEST FAILED: expected exception NAMESPACE_ERR 778/808 prefix10.xml 779/808 prefix11.xml 780/808 publicId01.xml @@ -904,7 +900,6 @@ TEST FAILED: There is no applicable method for the generic function 790/808 setAttributeNS05.xml 791/808 setAttributeNS06.xml 792/808 setAttributeNS07.xml -TEST FAILED: expected exception NAMESPACE_ERR 793/808 setAttributeNS09.xml 794/808 setAttributeNS10.xml 795/808 setAttributeNodeNS01.xml @@ -920,4 +915,4 @@ TEST FAILED: expected exception INUSE_ATTRIBUTE_ERR 803/808 setNamedItemNS04.xml 804/808 setNamedItemNS05.xml 805/808 systemId01.xml -38/763 tests failed; 45 tests were skipped \ No newline at end of file +34/763 tests failed; 45 tests were skipped \ No newline at end of file diff --git a/dom/dom-builder.lisp b/dom/dom-builder.lisp index 04486ee..1d6f372 100644 --- a/dom/dom-builder.lisp +++ b/dom/dom-builder.lisp @@ -45,8 +45,7 @@ (defmethod sax:start-dtd ((handler dom-builder) name publicid systemid) (let* ((document (document handler)) - (doctype - (dom:create-document-type 'implementation name publicid systemid))) + (doctype (%create-document-type name publicid systemid))) (setf (slot-value doctype 'dom-impl::owner) document (slot-value (dom:notations doctype) 'dom-impl::owner) document (slot-value (dom:entities doctype) 'dom-impl::owner) document diff --git a/dom/dom-impl.lisp b/dom/dom-impl.lisp index d8704b1..e2b835a 100644 --- a/dom/dom-impl.lisp +++ b/dom/dom-impl.lisp @@ -217,9 +217,7 @@ (or (string-equal (rod-string version) "1.0") (string-equal (rod-string version) "2.0")))) -(defmethod dom:create-document-type - ((factory (eql 'implementation)) name publicid systemid) - (safe-split-qname name #"") +(defun %create-document-type (name publicid systemid) (make-instance 'dom-impl::document-type :name name :notations (make-instance 'dom-impl::named-node-map @@ -231,6 +229,11 @@ :public-id publicid :system-id systemid)) +(defmethod dom:create-document-type + ((factory (eql 'implementation)) name publicid systemid) + (safe-split-qname name #"") + (%create-document-type name publicid systemid)) + (defmethod dom:create-document ((factory (eql 'implementation)) uri qname doctype) (let ((document (make-instance 'dom-impl::document))) @@ -363,6 +366,9 @@ (defmethod dom:create-attribute-ns ((document document) uri qname) (setf uri (%rod uri)) (setf qname (%rod qname)) + (when (and (rod= qname #"xmlns") + (not (rod= uri #"http://www.w3.org/2000/xmlns/"))) + (dom-error :NAMESPACE_ERR "invalid uri for qname `xmlns'")) (multiple-value-bind (prefix local-name) (safe-split-qname qname uri) (make-instance 'attribute diff --git a/xml/xml-parse.lisp b/xml/xml-parse.lisp index 0cbf1bb..c0395b2 100644 --- a/xml/xml-parse.lisp +++ b/xml/xml-parse.lisp @@ -3466,15 +3466,19 @@ (defun set-attribute-namespace (attribute) (let ((qname (sax:attribute-qname attribute))) - (multiple-value-bind (prefix local-name) (split-qname qname) - (declare (ignorable local-name)) - (when (and prefix ;; default namespace doesn't apply to attributes - (or (not (rod= #"xmlns" prefix)) sax:*use-xmlns-namespace*)) - (multiple-value-bind (uri prefix local-name) - (decode-qname qname) - (declare (ignore prefix)) - (setf (sax:attribute-namespace-uri attribute) uri) - (setf (sax:attribute-local-name attribute) local-name)))))) + (if (and sax:*use-xmlns-namespace* (rod= qname #"xmlns")) + (setf (sax:attribute-namespace-uri attribute) + #"http://www.w3.org/2000/xmlns/") + (multiple-value-bind (prefix local-name) (split-qname qname) + (declare (ignorable local-name)) + (when (and prefix ;; default namespace doesn't apply to attributes + (or (not (rod= #"xmlns" prefix)) + sax:*use-xmlns-namespace*)) + (multiple-value-bind (uri prefix local-name) + (decode-qname qname) + (declare (ignore prefix)) + (setf (sax:attribute-namespace-uri attribute) uri) + (setf (sax:attribute-local-name attribute) local-name))))))) ;;;;;;;;;;;;;;;;;