tvl-depot/third_party/lisp/s-xml/test/test-xml.lisp

Ignoring revisions in .git-blame-ignore-revs. Click here to bypass and see the normal blame view.

86 lines
2.3 KiB
Common Lisp
Raw Normal View History

;;;; -*- mode: lisp -*-
;;;;
;;;; $Id: test-xml.lisp,v 1.3 2005/11/06 12:44:48 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))
"&lt;foo&gt;"))
(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