mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2024-12-03 08:30:09 +00:00
Code Issues Releases Activity

Revert "cl-loop: Add missing guard condition"

Browse Source 
Don't merge to master.  This is a safe-for-release fix for Bug#40727.
This commit is contained in:
Noam Postavsky 2020-04-30 19:33:50 -04:00
parent 79e133da03
commit caf155c463
1 changed files with 7 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

32
lisp/emacs-lisp/cl-macs.el
View File

@ -897,7 +897,7 @@ This is compatible with Common Lisp, but note that `defun' and
(defvar cl--loop-name)
(defvar cl--loop-result) (defvar cl--loop-result-explicit)
(defvar cl--loop-result-var) (defvar cl--loop-steps)
(defvar cl--loop-symbol-macs) (defvar cl--loop-guard-cond)
(defvar cl--loop-symbol-macs)
(defun cl--loop-set-iterator-function (kind iterator)
(if cl--loop-iterator-function
@ -966,7 +966,7 @@ For more details, see Info node `(cl)Loop Facility'.
(cl--loop-accum-var nil) (cl--loop-accum-vars nil)
(cl--loop-initially nil) (cl--loop-finally nil)
(cl--loop-iterator-function nil) (cl--loop-first-flag nil)
(cl--loop-symbol-macs nil) (cl--loop-guard-cond nil))
(cl--loop-symbol-macs nil))
;; Here is more or less how those dynbind vars are used after looping
;; over cl--parse-loop-clause:
;;
@ -1001,24 +1001,7 @@ For more details, see Info node `(cl)Loop Facility'.
(list (or cl--loop-result-explicit
cl--loop-result))))
(ands (cl--loop-build-ands (nreverse cl--loop-body)))
(while-body
(nconc
(cadr ands)
(if (or (not cl--loop-guard-cond) (not cl--loop-first-flag))
(nreverse cl--loop-steps)
;; Right after update the loop variable ensure that the loop
;; condition, i.e. (car ands), is still satisfied; otherwise,
;; set `cl--loop-first-flag' nil and skip the remaining
;; body forms (#Bug#29799).
;;
;; (last cl--loop-steps) updates the loop var
;; (car (butlast cl--loop-steps)) sets `cl--loop-first-flag' nil
;; (nreverse (cdr (butlast cl--loop-steps))) are the
;; remaining body forms.
(append (last cl--loop-steps)
`((and ,(car ands)
,@(nreverse (cdr (butlast cl--loop-steps)))))
`(,(car (butlast cl--loop-steps)))))))
(while-body (nconc (cadr ands) (nreverse cl--loop-steps)))
(body (append
(nreverse cl--loop-initially)
(list (if cl--loop-iterator-function
@ -1528,11 +1511,10 @@ For more details, see Info node `(cl)Loop Facility'.
,(cl--loop-let (nreverse loop-for-sets) 'setq ands)
t)
cl--loop-body))
(when loop-for-steps
(setq cl--loop-guard-cond t)
(push (cons (if ands 'cl-psetq 'setq)
(apply 'append (nreverse loop-for-steps)))
cl--loop-steps))))
(if loop-for-steps
(push (cons (if ands 'cl-psetq 'setq)
(apply 'append (nreverse loop-for-steps)))
cl--loop-steps))))
((eq word 'repeat)
(let ((temp (make-symbol "--cl-var--")))