Commit | Line | Data |
---|---|---|
df3f1090 LC |
1 | ;;;; sxml.simple.test --- (sxml simple) -*- mode: scheme; coding: utf-8; -*- |
2 | ;;;; | |
e10c2509 | 3 | ;;;; Copyright (C) 2010, 2013 Free Software Foundation, Inc. |
df3f1090 LC |
4 | ;;;; |
5 | ;;;; This library is free software; you can redistribute it and/or | |
6 | ;;;; modify it under the terms of the GNU Lesser General Public | |
7 | ;;;; License as published by the Free Software Foundation; either | |
8 | ;;;; version 3 of the License, or (at your option) any later version. | |
9 | ;;;; | |
10 | ;;;; This library is distributed in the hope that it will be useful, | |
11 | ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
12 | ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU | |
13 | ;;;; Lesser General Public License for more details. | |
14 | ;;;; | |
15 | ;;;; You should have received a copy of the GNU Lesser General Public | |
16 | ;;;; License along with this library; if not, write to the Free Software | |
17 | ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA | |
18 | ||
19 | (define-module (test-sxml-simple) | |
20 | #:use-module (test-suite lib) | |
21 | #:use-module (sxml simple)) | |
22 | ||
e10c2509 AW |
23 | (define parser-error '(parser-error . "")) |
24 | ||
df3f1090 LC |
25 | (define %xml-sample |
26 | ;; An XML sample without any space in between tags, to make it easier. | |
27 | (string-append "<?xml version='1.0' encoding='utf-8'?>" | |
28 | "<foo chbouib=\"yes\">" | |
29 | "<bar/>" | |
30 | "<baz>" | |
31 | "<smurf one=\"1\"/>" | |
32 | "</baz>" | |
33 | "</foo>")) | |
34 | ||
35 | \f | |
36 | (with-test-prefix "simple" | |
37 | ||
38 | (pass-if "xml->sxml" | |
39 | (equal? (xml->sxml (open-input-string %xml-sample)) | |
40 | '(*TOP* | |
41 | (*PI* xml "version='1.0' encoding='utf-8'") | |
42 | (foo (@ (chbouib "yes")) | |
43 | (bar) | |
44 | (baz (smurf (@ (one "1")))))))) | |
45 | ||
46 | (pass-if "xml->sxml->xml->sxml" | |
47 | ;; Regression test for bug #29260. | |
48 | (equal? (xml->sxml (open-input-string %xml-sample)) | |
49 | (xml->sxml | |
50 | (open-input-string | |
51 | (with-output-to-string | |
52 | (lambda () | |
53 | (sxml->xml | |
54 | (xml->sxml (open-input-string %xml-sample)))))))))) | |
e10c2509 AW |
55 | |
56 | (with-test-prefix "namespaces" | |
57 | (pass-if-equal | |
58 | (xml->sxml "<foo xmlns=\"http://example.org/ns1\">text</foo>") | |
59 | '(*TOP* (http://example.org/ns1:foo "text"))) | |
60 | ||
61 | (pass-if-equal | |
62 | (xml->sxml "<foo xmlns=\"http://example.org/ns1\">text</foo>" | |
63 | #:namespaces '((ns1 . "http://example.org/ns1"))) | |
64 | '(*TOP* (ns1:foo "text"))) | |
65 | ||
66 | (pass-if-equal | |
67 | (xml->sxml "<foo xmlns:bar=\"http://example.org/ns2\"><bar:baz/></foo>" | |
68 | #:namespaces '((ns2 . "http://example.org/ns2"))) | |
69 | '(*TOP* (foo (ns2:baz)))) | |
70 | ||
71 | (pass-if-equal | |
72 | (xml->sxml "<foo><ns2:baz/></foo>" | |
73 | #:namespaces '((ns2 . "http://example.org/ns2"))) | |
74 | '(*TOP* (foo (ns2:baz)))) | |
75 | ||
76 | (pass-if-exception "namespace undeclared" parser-error | |
77 | (xml->sxml "<foo><ns2:baz/></foo>" | |
78 | #:namespaces '((ns2 . "http://example.org/ns2")) | |
79 | #:declare-namespaces? #f))) | |
80 | ||
81 | (with-test-prefix "whitespace" | |
82 | (pass-if-equal | |
83 | (xml->sxml "<foo>\n<bar> Alfie the parrot! </bar>\n</foo>") | |
84 | '(*TOP* (foo "\n" (bar " Alfie the parrot! ") "\n"))) | |
85 | ||
86 | (pass-if-equal | |
87 | (xml->sxml "<foo>\n<bar> Alfie the parrot! </bar>\n</foo>" | |
88 | #:trim-whitespace? #t) | |
89 | '(*TOP* (foo (bar " Alfie the parrot! "))))) | |
90 | ||
91 | (with-test-prefix "parsed entities" | |
92 | (pass-if-equal | |
93 | '(*TOP* (foo "&")) | |
94 | (xml->sxml "<foo>&</foo>")) | |
95 | ||
96 | (pass-if-exception "nbsp undefined" parser-error | |
97 | (xml->sxml "<foo> </foo>")) | |
98 | ||
99 | (pass-if-equal | |
100 | '(*TOP* (foo "\xA0")) | |
101 | (xml->sxml "<foo> </foo>" | |
102 | #:entities '((nbsp . "\xA0")))) | |
103 | ||
104 | (pass-if-equal | |
105 | '(*TOP* (foo "\xA0")) | |
106 | (xml->sxml "<foo> </foo>")) | |
107 | ||
108 | (let ((ents '())) | |
109 | (pass-if-equal | |
110 | (xml->sxml "<foo> &foo;</foo>" | |
111 | #:default-entity-handler | |
112 | (lambda (port name) | |
113 | (case name | |
114 | ((nbsp) "\xa0") | |
115 | (else | |
116 | (set! ents (cons name ents)) | |
117 | "qux")))) | |
118 | '(*TOP* (foo "\xa0 qux"))) | |
119 | ||
120 | (pass-if-equal | |
121 | ents | |
122 | '(foo)))) | |
123 | ||
124 | (with-test-prefix "doctype handlers" | |
125 | (define (handle-foo docname systemid internal-subset) | |
126 | (case docname | |
127 | ((foo) | |
128 | (values #:entities '((greets . "<i>Hello, world!</i>")))) | |
129 | (else | |
130 | (values)))) | |
131 | ||
132 | (pass-if-equal | |
133 | (xml->sxml "<!DOCTYPE foo><p>&greets;</p>" | |
134 | #:doctype-handler handle-foo) | |
135 | '(*TOP* (p (i "Hello, world!"))))) |