blob: daef58ea46399c46ee38842db31c939a26f1b99b (
plain) (
blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
|
;;;; -*- 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))
"<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
|
