OSCL/CXML
2
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Initial revision

Browse Source
This commit is contained in:
david
2005-03-13 18:02:10 +00:00
commit d6ca7664f4
81 changed files with 19663 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

37
xml/sax-tests/event-collecting-handler.lisp Normal file
View File

@ -0,0 +1,37 @@
(in-package :sax-tests)
(defclass event-collecting-handler ()
((event-list :initform '() :accessor event-list)))
(defmethod start-document ((handler event-collecting-handler))
(push (list :start-document) (event-list handler)))
(defmethod start-element ((handler event-collecting-handler) ns-uri local-name qname attrs)
(push (list :start-element ns-uri local-name qname attrs)
(event-list handler)))
(defmethod start-prefix-mapping ((handler event-collecting-handler) prefix uri)
(push (list :start-prefix-mapping prefix uri)
(event-list handler)))
(defmethod characters ((handler event-collecting-handler) data)
(push (list :characters data)
(event-list handler)))
(defmethod processing-instruction ((handler event-collecting-handler) target data)
(push (list :processing-instruction target data)
(event-list handler)))
(defmethod end-prefix-mapping ((handler event-collecting-handler) prefix)
(push (list :end-prefix-mapping prefix)
(event-list handler)))
(defmethod end-element ((handler event-collecting-handler) namespace-uri local-name qname)
(push (list :end-element namespace-uri local-name qname)
(event-list handler)))
(defmethod end-document ((handler event-collecting-handler))
(push (list :end-document)
(event-list handler))
(nreverse (event-list handler)))

4
xml/sax-tests/package.lisp Normal file
View File

@ -0,0 +1,4 @@
(defpackage :sax-tests
(:use :cl :xml :sax :glisp :rt)
(:export #:event-collecting-handler))

332
xml/sax-tests/tests.lisp Normal file
View File

@ -0,0 +1,332 @@
(in-package :sax-tests)
(defun first-start-element-event (string)
(let ((events (xml:parse-string string (make-instance 'event-collecting-handler))))
(find :start-element events :key #'car)))
;;; Attribute handling
(deftest no-default-namespace-for-attributes
(let* ((evt (first-start-element-event "<x xmlns='http://example.com' a='b'/>"))
(attr (car (fifth evt))))
(values
(attribute-namespace-uri attr)
(attribute-local-name attr)))
nil nil)
(deftest attribute-uniqueness-1
(handler-case
(xml:parse-string "<x xmlns:a='http://example.com' xmlns:b='http://example.com' a:a='1' b:a='1'/>")
(error () t)
(:no-error (&rest junk)
(declare (ignore junk))
nil))
t)
(deftest attribute-uniqueness-2
(handler-case
(xml:parse-string "<x xmlns:a='http://example.com' xmlns='http://example.com' a:a='1' a='1'/>")
(error () nil)
(:no-error (&rest junk)
(declare (ignore junk))
t))
t)
(deftest attribute-uniqueness-3
(let ((sax:*namespace-processing* nil))
(handler-case
(xml:parse-string "<x xmlns:a='http://example.com' xmlns:b='http://example.com' a:a='1' b:a='1'/>")
(error () nil)
(:no-error (&rest junk)
(declare (ignore junk))
t)))
t)
;;; Namespace undeclaring
(deftest undeclare-default-namespace-1
(let* ((evts (xml:parse-string "<x xmlns='http://example.com'><y xmlns='' a='1'/></x>"
(make-instance 'event-collecting-handler)))
(start-elt-events (remove :start-element evts :test (complement #'eql) :key #'car))
(evt1 (first start-elt-events))
(evt2 (second start-elt-events )))
(values
(rod= #"http://example.com" (second evt1))
(second evt2)
(third evt2)))
t nil nil)
(deftest undeclare-other-namespace
(handler-case
(xml:parse-string "<x:x xmlns:x='http://example.com'><x:y xmlns:x='' a='1'/></x:x>")
(error () t)
(:no-error (&rest junk)
(declare (ignore junk))
nil))
t)
;;; Require names otherwise totally out of scope of the xmlns rec to be NcNames for no reason
(deftest pi-names-are-ncnames-when-namespace-processing-1
(handler-case
(xml:parse-string "<?a:b c?><x/>")
(error () t)
(:no-error (&rest junk)
(declare (ignore junk))
nil))
t)
(deftest pi-names-are-ncnames-when-namespace-processing-2
(let ((sax:*namespace-processing* nil))
(handler-case
(xml:parse-string "<?a:b c?><x/>")
(error () nil)
(:no-error (&rest junk)
(declare (ignore junk))
t)))
t)
(deftest entity-names-are-ncnames-when-namespace-processing-1
(handler-case
(xml:parse-string "<!DOCTYPE x [ <!ENTITY y:z 'foo'> ]><x>&y:z;</x>")
(error () t)
(:no-error (&rest junk)
(declare (ignore junk))
nil))
t)
(deftest entity-names-are-ncnames-when-namespace-processing-2
(handler-case
(xml:parse-string "<!DOCTYPE x [ <!ENTITY y:z 'foo'> ]><x/>")
(error () t)
(:no-error (&rest junk)
(declare (ignore junk))
nil))
t)
(deftest entity-names-are-ncnames-when-namespace-processing-3
(let ((sax:*namespace-processing* nil))
(handler-case
(xml:parse-string "<!DOCTYPE x [ <!ENTITY y:z 'foo'> ]><x>&y:z;</x>")
(error () nil)
(:no-error (&rest junk)
(declare (ignore junk))
t)))
t)
(deftest entity-names-are-ncnames-when-namespace-processing-4
(let ((sax:*namespace-processing* nil))
(handler-case
(xml:parse-string "<!DOCTYPE x [ <!ENTITY y:z 'foo'> ]><x/>")
(error () nil)
(:no-error (&rest junk)
(declare (ignore junk))
t)))
t)
;;; Inclusion of xmlns attributes
(deftest xmlns-attr-include-1
(let* ((sax:*namespace-processing* t)
(sax:*include-xmlns-attributes* t)
(evt (first-start-element-event "<x xmlns='http://example.com'/>"))
(attrs (fifth evt)))
(length attrs))
1)
(deftest xmlns-attr-discard-1
(let* ((sax:*namespace-processing* t)
(sax:*include-xmlns-attributes* nil)
(evt (first-start-element-event "<x xmlns='http://example.com'/>"))
(attrs (fifth evt)))
(length attrs))
0)
;;; Namespace of xmlns attributes
(deftest xmlns-attr-ns-uri-1
(let* ((sax:*namespace-processing* t)
(sax:*include-xmlns-attributes* t)
(sax:*use-xmlns-namespace* nil)
(evt (first-start-element-event "<x xmlns='http://example.com'/>"))
(attrs (fifth evt)))
(attribute-namespace-uri (car attrs)))
nil)
(deftest xmlns-attr-ns-uri-2
(let* ((sax:*namespace-processing* t)
(sax:*include-xmlns-attributes* t)
(sax:*use-xmlns-namespace* nil)
(evt (first-start-element-event "<x xmlns:foo='http://example.com'/>"))
(attrs (fifth evt)))
(attribute-namespace-uri (car attrs)))
nil)
(deftest xmlns-attr-ns-uri-3
(let* ((sax:*namespace-processing* t)
(sax:*include-xmlns-attributes* t)
(sax:*use-xmlns-namespace* t)
(evt (first-start-element-event "<x xmlns='http://example.com'/>"))
(attrs (fifth evt)))
(attribute-namespace-uri (car attrs)))
nil)
(deftest xmlns-attr-ns-uri-4
(let* ((sax:*namespace-processing* t)
(sax:*include-xmlns-attributes* t)
(sax:*use-xmlns-namespace* t)
(evt (first-start-element-event "<x xmlns:foo='http://example.com'/>"))
(attrs (fifth evt)))
(rod= #"http://www.w3.org/2000/xmlns/" (attribute-namespace-uri (car attrs))))
t)
(deftest xmlns-attr-ns-local-name-1
(let* ((sax:*namespace-processing* t)
(sax:*include-xmlns-attributes* t)
(sax:*use-xmlns-namespace* nil)
(evt (first-start-element-event "<x xmlns='http://example.com'/>"))
(attrs (fifth evt)))
(attribute-local-name (car attrs)))
nil)
(deftest xmlns-attr-ns-local-name-2
(let* ((sax:*namespace-processing* t)
(sax:*include-xmlns-attributes* t)
(sax:*use-xmlns-namespace* nil)
(evt (first-start-element-event "<x xmlns:foo='http://example.com'/>"))
(attrs (fifth evt)))
(attribute-local-name (car attrs)))
nil)
(deftest xmlns-attr-ns-local-name-3
(let* ((sax:*namespace-processing* t)
(sax:*include-xmlns-attributes* t)
(sax:*use-xmlns-namespace* t)
(evt (first-start-element-event "<x xmlns='http://example.com'/>"))
(attrs (fifth evt)))
(attribute-local-name (car attrs)))
nil)
(deftest xmlns-attr-ns-local-name-4
(let* ((sax:*namespace-processing* t)
(sax:*include-xmlns-attributes* t)
(sax:*use-xmlns-namespace* t)
(evt (first-start-element-event "<x xmlns:foo='http://example.com'/>"))
(attrs (fifth evt)))
(rod= #"foo" (attribute-local-name (car attrs))))
t)
(deftest xmlns-attr-qname-1
(let* ((sax:*namespace-processing* t)
(sax:*include-xmlns-attributes* t)
(sax:*use-xmlns-namespace* nil)
(evt (first-start-element-event "<x xmlns='http://example.com'/>"))
(attrs (fifth evt)))
(rod= #"xmlns" (attribute-qname (car attrs))))
t)
(deftest xmlns-attr-qname-2
(let* ((sax:*namespace-processing* t)
(sax:*include-xmlns-attributes* t)
(sax:*use-xmlns-namespace* nil)
(evt (first-start-element-event "<x xmlns:foo='http://example.com'/>"))
(attrs (fifth evt)))
(rod= #"xmlns:foo" (attribute-qname (car attrs))))
t)
(deftest xmlns-attr-qname-4
(let* ((sax:*namespace-processing* t)
(sax:*include-xmlns-attributes* t)
(sax:*use-xmlns-namespace* t)
(evt (first-start-element-event "<x xmlns='http://example.com'/>"))
(attrs (fifth evt)))
(rod= #"xmlns" (attribute-qname (car attrs))))
t)
(deftest xmlns-attr-qname-4
(let* ((sax:*namespace-processing* t)
(sax:*include-xmlns-attributes* t)
(sax:*use-xmlns-namespace* t)
(evt (first-start-element-event "<x xmlns:foo='http://example.com'/>"))
(attrs (fifth evt)))
(rod= #"xmlns:foo" (attribute-qname (car attrs))))
t)
;;; Predefined Namespaces
(deftest redefine-xml-namespace-1
(handler-case
(xml:parse-string "<x xmlns:xml='http://www.w3.org/XML/1998/namespace'/>")
(error () nil)
(:no-error (&rest junk)
(declare (ignore junk))
t))
t)
(deftest redefine-xml-namespace-2
(handler-case
(xml:parse-string "<x xmlns:xml='http://example.com/wrong-uri'/>")
(error () t)
(:no-error (&rest junk)
(declare (ignore junk))
nil))
t)
(deftest redefine-xml-namespace-3
(handler-case
(xml:parse-string "<x xmlns:wrong='http://www.w3.org/XML/1998/namespace'/>")
(error () t)
(:no-error (&rest junk)
(declare (ignore junk))
nil))
t)
(deftest redefine-xml-namespace-4
(handler-case
(xml:parse-string "<x xmlns:wrong='http://www.w3.org/XML/1998/namespace'/>")
(error () t)
(:no-error (&rest junk)
(declare (ignore junk))
nil))
t)
(deftest redefine-xmlns-namespace-1
(handler-case
(xml:parse-string "<x xmlns:xmlns='http://www.w3.org/2000/xmlns/'/>")
(error () t)
(:no-error (&rest junk)
(declare (ignore junk))
nil))
t)
(deftest redefine-xmlns-namespace-2
(handler-case
(xml:parse-string "<x xmlns:xmlns='http://example.com/wrong-ns'/>")
(error () t)
(:no-error (&rest junk)
(declare (ignore junk))
nil))
t)
(deftest redefine-xmlns-namespace-3
(handler-case
(xml:parse-string "<x xmlns:wrong='http://www.w3.org/2000/xmlns/'/>")
(error () t)
(:no-error (&rest junk)
(declare (ignore junk))
nil))
t)
(deftest redefine-xmlns-namespace-4
(handler-case
(xml:parse-string "<x xmlns='http://www.w3.org/2000/xmlns/'/>")
(error () t)
(:no-error (&rest junk)
(declare (ignore junk))
nil))
t)