[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] master a036543: cl-loop: Add missing guard condition
From: |
Tino Calancha |
Subject: |
[Emacs-diffs] master a036543: cl-loop: Add missing guard condition |
Date: |
Mon, 8 Jan 2018 05:18:00 -0500 (EST) |
branch: master
commit a0365437c9ee308ad7978e436631020f513b25e7
Author: Tino Calancha <address@hidden>
Commit: Tino Calancha <address@hidden>
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.
---
lisp/emacs-lisp/cl-macs.el | 32 +++++++++++++++++++++++++-------
test/lisp/emacs-lisp/cl-macs-tests.el | 8 ++++++++
2 files changed, 33 insertions(+), 7 deletions(-)
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index 9af014c..43eb426 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -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--")))
diff --git a/test/lisp/emacs-lisp/cl-macs-tests.el
b/test/lisp/emacs-lisp/cl-macs-tests.el
index f0bde7a..edb1530 100644
--- a/test/lisp/emacs-lisp/cl-macs-tests.el
+++ b/test/lisp/emacs-lisp/cl-macs-tests.el
@@ -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
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Emacs-diffs] master a036543: cl-loop: Add missing guard condition,
Tino Calancha <=