From: John Wiegley <johnw@newartisans.com> Date: Fri, 11 Mar 2016 21:32:13 +0000 (-0800) Subject: Merge from origin/emacs-25 X-Git-Tag: emacs-26.0.90~2350 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=a934bf445ffaa7920aa1dfea47fe08920bbbc94c;p=emacs.git Merge from origin/emacs-25 620951f Fix previous fix of enlarge-/shrink-window 2e78353 * lisp/isearch.el (isearch-define-mode-toggle): Fix toggling logic 66d2717 Complete temperature units in calc-convert-temperature dbb02bf Make sure to use case-sensitive search 8b01e69 Prevent infinite loop on not-well-formed xml. (Bug#16344) 100346a Add the missing test case for the previous patch 5aba61e Use the correct dabbrev expansion --- a934bf445ffaa7920aa1dfea47fe08920bbbc94c diff --cc test/lisp/xml-tests.el index 763febb9b69,00000000000..488d2c6f920 mode 100644,000000..100644 --- a/test/lisp/xml-tests.el +++ b/test/lisp/xml-tests.el @@@ -1,136 -1,0 +1,141 @@@ +;;; xml-parse-tests.el --- Test suite for XML parsing. + +;; Copyright (C) 2012-2016 Free Software Foundation, Inc. + +;; Author: Chong Yidong <cyd@stupidchicken.com> +;; Keywords: internal +;; Human-Keywords: internal + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Type M-x test-xml-parse RET to generate the test buffer. + +;;; Code: + +(require 'ert) +(require 'xml) + +(defvar xml-parse-tests--data + `(;; General entity substitution + ("<?xml version=\"1.0\"?><!DOCTYPE foo SYSTEM \"bar.dtd\" [<!ENTITY ent \"AbC\">]><foo a=\"b\"><bar>&ent;;</bar></foo>" . + ((foo ((a . "b")) (bar nil "AbC;")))) + ("<?xml version=\"1.0\"?><foo>&amp;&apos;'<>"</foo>" . + ((foo () "&''<>\""))) + ;; Parameter entity substitution + ("<?xml version=\"1.0\"?><!DOCTYPE foo SYSTEM \"bar.dtd\" [<!ENTITY % pent \"AbC\"><!ENTITY ent \"%pent;\">]><foo a=\"b\"><bar>&ent;;</bar></foo>" . + ((foo ((a . "b")) (bar nil "AbC;")))) + ;; Tricky parameter entity substitution (like XML spec Appendix D) + ("<?xml version='1.0'?><!DOCTYPE foo [ <!ENTITY % xx '%zz;'><!ENTITY % zz '<!ENTITY ent \"b\" >' > %xx; ]><foo>A&ent;C</foo>" . + ((foo () "AbC"))) + ;; Bug#7172 + ("<?xml version=\"1.0\"?><!DOCTYPE foo [ <!ELEMENT EXAM_PLE EMPTY> ]><foo></foo>" . + ((foo ()))) + ;; Entities referencing entities, in character data + ("<!DOCTYPE foo [ <!ENTITY b \"B\"><!ENTITY abc \"a&b;c\">]><foo>&abc;</foo>" . + ((foo () "aBc"))) + ;; Entities referencing entities, in attribute values + ("<!DOCTYPE foo [ <!ENTITY b \"B\"><!ENTITY abc \"a&b;c\">]><foo a=\"-&abc;-\">1</foo>" . + ((foo ((a . "-aBc-")) "1"))) + ;; Character references must be treated as character data + ("<foo>AT&T;</foo>" . ((foo () "AT&T;"))) + ("<foo>&amp;</foo>" . ((foo () "&"))) + ("<foo>&amp;</foo>" . ((foo () "&"))) + ;; Unusual but valid XML names [5] + ("<ÃÃÃö.3·-â¿â󯿿>abc</ÃÃÃö.3·-â¿â󯿿>" . ((,(intern "ÃÃÃö.3·-â¿â󯿿") () "abc"))) + ("<:>abc</:>" . ((,(intern ":") () "abc")))) + "Alist of XML strings and their expected parse trees.") + +(defvar xml-parse-tests--bad-data + '(;; XML bomb in content + "<!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>" + ;; XML bomb in attribute value + "<!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>" + ;; Non-terminating DTD + "<!DOCTYPE foo [ <!ENTITY b \"B\"><!ENTITY abc \"a&b;c\">" + "<!DOCTYPE foo [ <!ENTITY b \"B\"><!ENTITY abc \"a&b;c\">asdf" + "<!DOCTYPE foo [ <!ENTITY b \"B\"><!ENTITY abc \"a&b;c\">asdf&abc;" + ;; Invalid XML names + "<0foo>abc</0foo>" + "<â¿foo>abc</â¿foo>" - "<f¿>abc</f¿>") ++ "<f¿>abc</f¿>" ++ ;; Two root tags ++ "<a/><b></b>" ++ ;; Bug#16344 ++ "<!----><x>< /x>" ++ "<a>< b/></a>") + "List of XML strings that should signal an error in the parser") + +(defvar xml-parse-tests--qnames + '( ;; Test data for name expansion + ("<?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>" + ;; Result with qnames as cons + ((("DAV:" . "multistatus") + ((("http://www.w3.org/2000/xmlns/" . "D") . "DAV:")) + (("DAV:" . "response") nil (("DAV:" . "href") nil "/calendar/events/") + (("DAV:" . "propstat") nil (("DAV:" . "status") nil "HTTP/1.1 200 OK"))))) + ;; Result with qnames as symbols + ((DAV:multistatus + ((("http://www.w3.org/2000/xmlns/" . "D") . "DAV:")) + (DAV:response nil (DAV:href nil "/calendar/events/") + (DAV:propstat nil (DAV:status nil "HTTP/1.1 200 OK")))))) + ("<?xml version=\"1.0\" encoding=\"UTF-8\"?><F:something>hi there</F:something>" + ((("FOOBAR:" . "something") nil "hi there")) + ((FOOBAR:something nil "hi there")))) + "List of strings which are parsed using namespace expansion. +Parser is called with and without 'symbol-qnames argument.") + +(ert-deftest xml-parse-tests () + "Test XML parsing." + (with-temp-buffer + (dolist (test xml-parse-tests--data) + (erase-buffer) + (insert (car test)) + (should (equal (cdr test) (xml-parse-region)))) + (let ((xml-entity-expansion-limit 50)) + (dolist (test xml-parse-tests--bad-data) + (erase-buffer) + (insert test) + (should-error (xml-parse-region)))) + (let ((testdata (car xml-parse-tests--qnames))) + (erase-buffer) + (insert (car testdata)) + (should (equal (nth 1 testdata) + (xml-parse-region nil nil nil nil t))) + (should (equal (nth 2 testdata) + (xml-parse-region nil nil nil nil 'symbol-qnames)))) + (let ((testdata (nth 1 xml-parse-tests--qnames))) + (erase-buffer) + (insert (car testdata)) + ;; Provide additional namespace-URI mapping + (should (equal (nth 1 testdata) + (xml-parse-region + nil nil nil nil + (append xml-default-ns + '(("F" . "FOOBAR:")))))) + (should (equal (nth 2 testdata) + (xml-parse-region + nil nil nil nil + (cons 'symbol-qnames + (append xml-default-ns + '(("F" . "FOOBAR:")))))))))) + +;; Local Variables: +;; no-byte-compile: t +;; End: + +;;; xml-parse-tests.el ends here.