* xml.el (xml-parse-dtd): Use proper regexps for ELEMENT declarations.

* test/automated/xml-parse-tests.el: Update testcase.

Fixes: debbugs:7172

3 files changed, 14 insertions, 7 deletions

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 3156dc412e3..d6ad29309e7 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -7,6 +7,7 @@
         Use xml--parse-buffer.
         (xml-parse-file): Use xml--parse-buffer.
         (xml-parse-dtd): Make parameter entity substitution work right.
+        Use proper regexps for ELEMENT declarations (Bug#7172).
 
 2012-06-30  Glenn Morris  <rgm@gnu.org>
 
diff --git a/lisp/xml.el b/lisp/xml.el
index 841e19a174a..5c1d2390a23 100644
--- a/lisp/xml.el
+++ b/lisp/xml.el
@@ -651,7 +651,9 @@ This follows the rule [28] in the XML specifications."
         (skip-syntax-forward " ")
         (cond
          ;; Element declaration [45]:
-         ((and (looking-at "<!ELEMENT\\s-+\\([[:alnum:].%;]+\\)\\s-+\\([^>]+\\)>")
+         ((and (looking-at (eval-when-compile
+                             (concat "<!ELEMENT\\s-+\\(" xml-name-re
+                                     "\\)\\s-+\\([^>]+\\)>")))
                (or (null next-parameter-entity)
                    (<= (match-end 0) next-parameter-entity)))
           (let ((element (match-string-no-properties 1))
@@ -659,13 +661,14 @@ This follows the rule [28] in the XML specifications."
                 (end-pos (match-end 0)))
             ;; Translation of rule [46] of XML specifications
             (cond
-             ((string-match "^EMPTY[ \t\n\r]*$" type)       ; empty declaration
+             ((string-match "\\`EMPTY\\s-*\\'" type)  ; empty declaration
               (setq type 'empty))
-             ((string-match "^ANY[ \t\n\r]*$" type)         ; any type of contents
+             ((string-match "\\`ANY\\s-*$" type)      ; any type of contents
               (setq type 'any))
-             ((string-match "^(\\(.*\\))[ \t\n\r]*$" type)  ; children ([47])
-              (setq type (xml-parse-elem-type (match-string-no-properties 1 type))))
-             ((string-match "^%[^;]+;[ \t\n\r]*$" type)   ; substitution
+             ((string-match "\\`(\\(.*\\))\\s-*\\'" type) ; children ([47])
+              (setq type (xml-parse-elem-type
+                          (match-string-no-properties 1 type))))
+             ((string-match "^%[^;]+;[ \t\n\r]*\\'" type) ; substitution
               nil)
              (xml-validating-parser
               (error "XML: (Validity) Invalid element type in the DTD")))
diff --git a/test/automated/xml-parse-tests.el b/test/automated/xml-parse-tests.el
index 8e8ef291bdc..8322a8c6ff9 100644
--- a/test/automated/xml-parse-tests.el
+++ b/test/automated/xml-parse-tests.el
@@ -38,7 +38,10 @@
      ((foo ((a . "b")) (bar nil "AbC;"))))
     ;; Tricky parameter entity substitution (like XML spec Appendix D)
     ("<?xml version='1.0'?><!DOCTYPE foo [ <!ENTITY % xx '&#37;zz;'><!ENTITY % zz '&#60;!ENTITY ent \"b\" >' > %xx; ]><foo>A&ent;C</foo>" .
-     ((foo nil "AbC"))))
+     ((foo nil "AbC")))
+    ;; Bug#7172
+    ("<?xml version=\"1.0\"?><!DOCTYPE foo [ <!ELEMENT EXAM_PLE EMPTY> ]><foo></foo>" .
+     ((foo nil))))
   "Alist of XML strings and their expected parse trees.")
 
 (ert-deftest xml-parse-tests ()