diff options
Diffstat (limited to 'third-party/s-xml/test/test-xml.lisp')
| -rw-r--r-- | third-party/s-xml/test/test-xml.lisp | 86 |
1 files changed, 86 insertions, 0 deletions
diff --git a/third-party/s-xml/test/test-xml.lisp b/third-party/s-xml/test/test-xml.lisp new file mode 100644 index 0000000..6d636a8 --- /dev/null +++ b/third-party/s-xml/test/test-xml.lisp @@ -0,0 +1,86 @@ +;;;; -*- mode: lisp -*- +;;;; +;;;; $Id: test-xml.lisp,v 1.4 2006-01-19 20:00:06 scaekenberghe Exp $ +;;;; +;;;; Unit and functional tests for xml.lisp +;;;; +;;;; Copyright (C) 2002, 2004 Sven Van Caekenberghe, Beta Nine BVBA. +;;;; +;;;; You are granted the rights to distribute and use this software +;;;; as governed by the terms of the Lisp Lesser General Public License +;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL. + +(in-package :s-xml) + +(assert + (whitespace-char-p (character " "))) + +(assert + (whitespace-char-p (character " "))) + +(assert + (whitespace-char-p (code-char 10))) + +(assert + (whitespace-char-p (code-char 13))) + +(assert + (not (whitespace-char-p #\A))) + +(assert + (char= (with-input-from-string (stream " ABC") + (skip-whitespace stream)) + #\A)) + +(assert + (char= (with-input-from-string (stream "ABC") + (skip-whitespace stream)) + #\A)) + +(assert + (string-equal (with-output-to-string (stream) (print-string-xml "<foo>" stream)) + "<foo>")) + +(assert + (string-equal (with-output-to-string (stream) (print-string-xml "' '" stream)) + "' '")) + +(assert + (let ((string (map 'string #'identity '(#\return #\tab #\newline)))) + (string-equal (with-output-to-string (stream) (print-string-xml string stream)) + string))) + +(defun simple-echo-xml (in out) + (start-parse-xml + in + (make-instance 'xml-parser-state + :new-element-hook #'(lambda (name attributes seed) + (declare (ignore seed)) + (format out "<~a~:{ ~a='~a'~}>" + name + (mapcar #'(lambda (p) (list (car p) (cdr p))) + (reverse attributes)))) + :finish-element-hook #'(lambda (name attributes parent-seed seed) + (declare (ignore attributes parent-seed seed)) + (format out "</~a>" name)) + :text-hook #'(lambda (string seed) + (declare (ignore seed)) + (princ string out))))) + +(defun simple-echo-xml-string (string) + (with-input-from-string (in string) + (with-output-to-string (out) + (simple-echo-xml in out)))) + +(dolist (*ignore-namespaces* '(nil t)) + (assert + (let ((xml "<FOO ATT1='1' ATT2='2'><B>Text</B><EMPTY></EMPTY>More text!<SUB><SUB></SUB></SUB></FOO>")) + (equal (simple-echo-xml-string xml) + xml)))) + +(assert + (let ((xml "<p> </p>")) + (equal (simple-echo-xml-string xml) + xml))) + +;;;; eof
\ No newline at end of file |