Commit | Line | Data |
---|---|---|
fbf2e7ad CY |
1 | ;;; xml-parse-tests.el --- Test suite for XML parsing. |
2 | ||
ab422c4d | 3 | ;; Copyright (C) 2012-2013 Free Software Foundation, Inc. |
fbf2e7ad CY |
4 | |
5 | ;; Author: Chong Yidong <cyd@stupidchicken.com> | |
6 | ;; Keywords: internal | |
7 | ;; Human-Keywords: internal | |
8 | ||
9 | ;; This file is part of GNU Emacs. | |
10 | ||
11 | ;; GNU Emacs is free software: you can redistribute it and/or modify | |
12 | ;; it under the terms of the GNU General Public License as published by | |
13 | ;; the Free Software Foundation, either version 3 of the License, or | |
14 | ;; (at your option) any later version. | |
15 | ||
16 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
17 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
18 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
19 | ;; GNU General Public License for more details. | |
20 | ||
21 | ;; You should have received a copy of the GNU General Public License | |
22 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. | |
23 | ||
24 | ;;; Commentary: | |
25 | ||
26 | ;; Type M-x test-xml-parse RET to generate the test buffer. | |
27 | ||
28 | ;;; Code: | |
29 | ||
30 | (require 'xml) | |
31 | ||
32 | (defvar xml-parse-tests--data | |
566df3fc | 33 | `(;; General entity substitution |
fbf2e7ad CY |
34 | ("<?xml version=\"1.0\"?><!DOCTYPE foo SYSTEM \"bar.dtd\" [<!ENTITY ent \"AbC\">]><foo a=\"b\"><bar>&ent;;</bar></foo>" . |
35 | ((foo ((a . "b")) (bar nil "AbC;")))) | |
566df3fc | 36 | ("<?xml version=\"1.0\"?><foo>&amp;&apos;'<>"</foo>" . |
a7aef6f5 | 37 | ((foo () "&''<>\""))) |
fbf2e7ad CY |
38 | ;; Parameter entity substitution |
39 | ("<?xml version=\"1.0\"?><!DOCTYPE foo SYSTEM \"bar.dtd\" [<!ENTITY % pent \"AbC\"><!ENTITY ent \"%pent;\">]><foo a=\"b\"><bar>&ent;;</bar></foo>" . | |
40 | ((foo ((a . "b")) (bar nil "AbC;")))) | |
41 | ;; Tricky parameter entity substitution (like XML spec Appendix D) | |
42 | ("<?xml version='1.0'?><!DOCTYPE foo [ <!ENTITY % xx '%zz;'><!ENTITY % zz '<!ENTITY ent \"b\" >' > %xx; ]><foo>A&ent;C</foo>" . | |
a7aef6f5 | 43 | ((foo () "AbC"))) |
6fe566a7 CY |
44 | ;; Bug#7172 |
45 | ("<?xml version=\"1.0\"?><!DOCTYPE foo [ <!ELEMENT EXAM_PLE EMPTY> ]><foo></foo>" . | |
a7aef6f5 CY |
46 | ((foo ()))) |
47 | ;; Entities referencing entities, in character data | |
48 | ("<!DOCTYPE foo [ <!ENTITY b \"B\"><!ENTITY abc \"a&b;c\">]><foo>&abc;</foo>" . | |
49 | ((foo () "aBc"))) | |
50 | ;; Entities referencing entities, in attribute values | |
51 | ("<!DOCTYPE foo [ <!ENTITY b \"B\"><!ENTITY abc \"a&b;c\">]><foo a=\"-&abc;-\">1</foo>" . | |
52 | ((foo ((a . "-aBc-")) "1"))) | |
53 | ;; Character references must be treated as character data | |
54 | ("<foo>AT&T;</foo>" . ((foo () "AT&T;"))) | |
566df3fc CY |
55 | ("<foo>&amp;</foo>" . ((foo () "&"))) |
56 | ("<foo>&amp;</foo>" . ((foo () "&"))) | |
57 | ;; Unusual but valid XML names [5] | |
58 | ("<ÀÖØö.3·-‿⁀>abc</ÀÖØö.3·-‿⁀>" . ((,(intern "ÀÖØö.3·-‿⁀") () "abc"))) | |
59 | ("<:>abc</:>" . ((,(intern ":") () "abc")))) | |
fbf2e7ad CY |
60 | "Alist of XML strings and their expected parse trees.") |
61 | ||
a76e6535 CY |
62 | (defvar xml-parse-tests--bad-data |
63 | '(;; XML bomb in content | |
64 | "<!DOCTYPE foo [<!ENTITY lol \"lol\"><!ENTITY lol1 \"&lol;&lol;&lol;&lol;&lol;&lol;&lol;&lol;&lol;&lol;\"><!ENTITY lol2 \"&lol1;&lol1;&lol1;&lol1;&lol1;&lol1;&lol1;&lol1;&lol1;&lol1;\">]><foo>&lol2;</foo>" | |
65 | ;; XML bomb in attribute value | |
66 | "<!DOCTYPE foo [<!ENTITY lol \"lol\"><!ENTITY lol1 \"&lol;&lol;&lol;&lol;&lol;&lol;&lol;&lol;&lol;&lol;\"><!ENTITY lol2 \"&lol1;&lol1;&lol1;&lol1;&lol1;&lol1;&lol1;&lol1;&lol1;&lol1;\">]><foo a=\"&lol2;\">!</foo>" | |
67 | ;; Non-terminating DTD | |
68 | "<!DOCTYPE foo [ <!ENTITY b \"B\"><!ENTITY abc \"a&b;c\">" | |
69 | "<!DOCTYPE foo [ <!ENTITY b \"B\"><!ENTITY abc \"a&b;c\">asdf" | |
566df3fc CY |
70 | "<!DOCTYPE foo [ <!ENTITY b \"B\"><!ENTITY abc \"a&b;c\">asdf&abc;" |
71 | ;; Invalid XML names | |
72 | "<0foo>abc</0foo>" | |
73 | "<‿foo>abc</‿foo>" | |
74 | "<f¿>abc</f¿>") | |
a76e6535 CY |
75 | "List of XML strings that should signal an error in the parser") |
76 | ||
c91562a6 DE |
77 | (defvar xml-parse-tests--qnames |
78 | '( ;; Test data for name expansion | |
79 | ("<?xml version=\"1.0\" encoding=\"UTF-8\"?><D:multistatus xmlns:D=\"DAV:\"><D:response><D:href>/calendar/events/</D:href><D:propstat><D:status>HTTP/1.1 200 OK</D:status></D:propstat></D:response></D:multistatus>" | |
80 | ;; Result with qnames as cons | |
81 | ((("DAV:" . "multistatus") | |
82 | ((("http://www.w3.org/2000/xmlns/" . "D") . "DAV:")) | |
83 | (("DAV:" . "response") nil (("DAV:" . "href") nil "/calendar/events/") | |
84 | (("DAV:" . "propstat") nil (("DAV:" . "status") nil "HTTP/1.1 200 OK"))))) | |
85 | ;; Result with qnames as symbols | |
86 | ((DAV:multistatus | |
87 | ((("http://www.w3.org/2000/xmlns/" . "D") . "DAV:")) | |
88 | (DAV:response nil (DAV:href nil "/calendar/events/") | |
89 | (DAV:propstat nil (DAV:status nil "HTTP/1.1 200 OK")))))) | |
90 | ("<?xml version=\"1.0\" encoding=\"UTF-8\"?><F:something>hi there</F:something>" | |
91 | ((("FOOBAR:" . "something") nil "hi there")) | |
92 | ((FOOBAR:something nil "hi there")))) | |
93 | "List of strings which are parsed using namespace expansion. | |
94 | Parser is called with and without 'symbol-qnames argument.") | |
95 | ||
fbf2e7ad CY |
96 | (ert-deftest xml-parse-tests () |
97 | "Test XML parsing." | |
98 | (with-temp-buffer | |
99 | (dolist (test xml-parse-tests--data) | |
100 | (erase-buffer) | |
101 | (insert (car test)) | |
a76e6535 CY |
102 | (should (equal (cdr test) (xml-parse-region)))) |
103 | (let ((xml-entity-expansion-limit 50)) | |
104 | (dolist (test xml-parse-tests--bad-data) | |
105 | (erase-buffer) | |
106 | (insert test) | |
c91562a6 DE |
107 | (should-error (xml-parse-region)))) |
108 | (let ((testdata (car xml-parse-tests--qnames))) | |
109 | (erase-buffer) | |
110 | (insert (car testdata)) | |
111 | (should (equal (nth 1 testdata) | |
112 | (xml-parse-region nil nil nil nil t))) | |
113 | (should (equal (nth 2 testdata) | |
114 | (xml-parse-region nil nil nil nil 'symbol-qnames)))) | |
115 | (let ((testdata (nth 1 xml-parse-tests--qnames))) | |
116 | (erase-buffer) | |
117 | (insert (car testdata)) | |
118 | ;; Provide additional namespace-URI mapping | |
119 | (should (equal (nth 1 testdata) | |
120 | (xml-parse-region | |
121 | nil nil nil nil | |
122 | (append xml-default-ns | |
123 | '(("F" . "FOOBAR:")))))) | |
124 | (should (equal (nth 2 testdata) | |
125 | (xml-parse-region | |
126 | nil nil nil nil | |
127 | (cons 'symbol-qnames | |
128 | (append xml-default-ns | |
129 | '(("F" . "FOOBAR:")))))))))) | |
fbf2e7ad CY |
130 | |
131 | ;; Local Variables: | |
132 | ;; no-byte-compile: t | |
133 | ;; End: | |
134 | ||
135 | ;;; xml-parse-tests.el ends here. |