Bug fix: guard against left recursion in DTDs.

svenemtell · May 24, 2020 · f82a96a · f82a96a
1 parent adb4430
commit f82a96a
Showing 1 changed file with 6 additions and 2 deletions.
diff --git a/xml/xml-parse.lisp b/xml/xml-parse.lisp
@@ -2224,6 +2224,8 @@
                  (t nil))))
       #'doit)))
 
+(defvar *left-recursion* nil)
+
 (defun compile-content-model (cspec &optional (continuation #'cmodel-done))
   (if (vectorp cspec)
       (lambda (actual-name)
@@ -2251,9 +2253,11 @@
         (*
           (let (maybe-continuation)
             (labels ((recurse (actual-name)
-                       (if (null actual-name)
+                       (if (or (null actual-name)
+                               *left-recursion*)
                            (funcall continuation actual-name)
-                           (or (funcall maybe-continuation actual-name)
+                           (or (let ((*left-recursion* t))
+                                 (funcall maybe-continuation actual-name))
                                (funcall continuation actual-name)))))
               (setf maybe-continuation
                     (compile-content-model (second cspec) #'recurse))