(byte-compile--first-symbol-with-pos): Fix bug#58601

* lisp/emacs-lisp/bytecomp.el: Require `subr-x`.
(byte-compile--first-symbol-with-pos): Avoid inf-loops on circular data.
This commit is contained in:
Stefan Monnier 2022-10-18 10:49:43 -04:00
parent 254536e41b
commit c5e2566774

View file

@ -129,6 +129,7 @@
;; us from emitting warnings when compiling files which use cl-lib without
;; requiring it! (bug#30635)
(eval-when-compile (require 'cl-lib))
(eval-when-compile (require 'subr-x))
;; The feature of compiling in a specific target Emacs version
;; has been turned off because compile time options are a bad idea.
@ -1185,27 +1186,22 @@ message buffer `default-directory'."
(defun byte-compile--first-symbol-with-pos (form)
"Return the first symbol with position in form, or nil if none.
Order is by depth-first search."
(cond
((symbol-with-pos-p form) form)
((consp form)
(or (byte-compile--first-symbol-with-pos (car form))
(let ((sym nil))
(setq form (cdr form))
(while (and (consp form)
(not (setq sym (byte-compile--first-symbol-with-pos
(car form)))))
(setq form (cdr form)))
(or sym
(and form (byte-compile--first-symbol-with-pos form))))))
((or (vectorp form) (recordp form))
(let ((len (length form))
(i 0)
(sym nil))
(while (and (< i len)
(not (setq sym (byte-compile--first-symbol-with-pos
(aref form i)))))
(setq i (1+ i)))
sym))))
(named-let loop ((form form)
(depth 10)) ;Arbitrary limit.
(cond
((<= depth 0) nil) ;Avoid cycles (bug#58601).
((symbol-with-pos-p form) form)
((consp form)
(or (loop (car form) (1- depth))
(loop (cdr form) (1- depth))))
((or (vectorp form) (recordp form))
(let ((len (length form))
(i 0)
(sym nil))
(while (and (< i len)
(not (setq sym (loop (aref form i) (1- depth)))))
(setq i (1+ i)))
sym)))))
(defun byte-compile--warning-source-offset ()
"Return a source offset from `byte-compile-form-stack' or nil if none."