mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-06 06:20:55 -08:00
Code Issues Projects Releases Wiki Activity

cl-loop: Add missing guard condition

Browse source 
Consider the expansion of `cl-loop' with a `for' clause and more
than one internal variables, X, Y, processed in parallel.
Each step updates X and Y right after update the loop variable, K; if
either X or Y depend on K, then some forms of the body are
evaluated with the wrong K (Bug#29799).

For instance, consider the following code:
(cl-loop for k below 2
         for x = (progn (message "k = %d" k) 1)
         and y = 1)

This code should show in *Messages*:
k = 0
k = 1

Instead, the code shows:
k = 0
k = 1
k = 2

To prevent this we must ensure that the loop condition is still
satisfied right after update the loop variable.
In the macro expansion of the example above, right after:
(setq k (+ k 1))

evaluate the rest of the body forms iif the condition
(< k 2)
is still valid.

* lisp/emacs-lisp/cl-macs.el (cl--loop-guard-cond): New variable.
(cl--parse-loop-clause): Set it non-nil if the loop contains
a for/as clause.
(cl-loop): After update the loop variable, evaluate the remaining of
the body forms just if the loop condition is still valid (Bug#29799).

* test/lisp/emacs-lisp/cl-macs-tests.el (cl-macs-loop-for-as-equals-and):
New test.
This commit is contained in:
Tino Calancha 2018-01-08 19:11:20 +09:00
parent 1daac66a6e
commit a0365437c9
2 changed files with 33 additions and 7 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -892,7 +892,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-symbol-macs) (defvar cl--loop-guard-cond)
(defun cl--loop-set-iterator-function (kind iterator)
(if cl--loop-iterator-function
@ -961,7 +961,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-symbol-macs nil) (cl--loop-guard-cond nil))
;; Here is more or less how those dynbind vars are used after looping
;; over cl--parse-loop-clause:
;;
@ -996,7 +996,24 @@ 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) (nreverse cl--loop-steps)))
(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)))))))
(body (append
(nreverse cl--loop-initially)
(list (if cl--loop-iterator-function
@ -1506,10 +1523,11 @@ For more details, see Info node `(cl)Loop Facility'.
,(cl--loop-let (nreverse loop-for-sets) 'setq ands)
t)
cl--loop-body))
(if loop-for-steps
(push (cons (if ands 'cl-psetq 'setq)
(apply 'append (nreverse loop-for-steps)))
cl--loop-steps))))
(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))))
((eq word 'repeat)
(let ((temp (make-symbol "--cl-var--")))