cl-loop: Add missing guard condition
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:
parent
1daac66a6e
commit
a0365437c9
2 changed files with 33 additions and 7 deletions
|
@ -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--")))
|
||||
|
|
|
@ -497,4 +497,12 @@ collection clause."
|
|||
vconcat (vector (1+ x)))
|
||||
[2 3 4 5 6])))
|
||||
|
||||
|
||||
(ert-deftest cl-macs-loop-for-as-equals-and ()
|
||||
"Test for https://debbugs.gnu.org/29799 ."
|
||||
(let ((arr (make-vector 3 0)))
|
||||
(should (equal '((0 0) (1 1) (2 2))
|
||||
(cl-loop for k below 3 for x = k and z = (elt arr k)
|
||||
collect (list k x))))))
|
||||
|
||||
;;; cl-macs-tests.el ends here
|
||||
|
|
Loading…
Add table
Reference in a new issue