[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
master ddc8020 2/2: Don't increment array index in cl-loop twice (Bug#40
From: |
Noam Postavsky |
Subject: |
master ddc8020 2/2: Don't increment array index in cl-loop twice (Bug#40727) |
Date: |
Thu, 7 May 2020 08:26:50 -0400 (EDT) |
branch: master
commit ddc8020327604b92e7e830708933f62a22f48f62
Author: Noam Postavsky <address@hidden>
Commit: Noam Postavsky <address@hidden>
Don't increment array index in cl-loop twice (Bug#40727)
* lisp/emacs-lisp/cl-macs.el (cl--parse-loop-clause): Put the temp-idx
increment in cl--loop-body, leaving just the side-effect free testing
of the index for both cl--loop-body and cl--loop-conditions.
* test/lisp/emacs-lisp/cl-macs-tests.el (cl-macs-loop-and-arrays):
Extend test to cover this case.
---
lisp/emacs-lisp/cl-macs.el | 3 ++-
test/lisp/emacs-lisp/cl-macs-tests.el | 3 +++
2 files changed, 5 insertions(+), 1 deletion(-)
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index fef8786..3317c58 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -1320,8 +1320,9 @@ For more details, see Info node `(cl)Loop Facility'.
(temp-idx (make-symbol "--cl-idx--")))
(push (list temp-vec (pop cl--loop-args)) loop-for-bindings)
(push (list temp-idx -1) loop-for-bindings)
+ (push `(setq ,temp-idx (1+ ,temp-idx)) cl--loop-body)
(cl--push-clause-loop-body
- `(< (setq ,temp-idx (1+ ,temp-idx)) (length ,temp-vec)))
+ `(< ,temp-idx (length ,temp-vec)))
(if (eq word 'across-ref)
(push (list var `(aref ,temp-vec ,temp-idx))
cl--loop-symbol-macs)
diff --git a/test/lisp/emacs-lisp/cl-macs-tests.el
b/test/lisp/emacs-lisp/cl-macs-tests.el
index 77609a4..983e79a 100644
--- a/test/lisp/emacs-lisp/cl-macs-tests.el
+++ b/test/lisp/emacs-lisp/cl-macs-tests.el
@@ -43,6 +43,9 @@
"Bug#40727"
(should (equal (cl-loop for y = (- (or x 0)) and x across [1 2]
collect (cons x y))
+ '((1 . 0) (2 . -1))))
+ (should (equal (cl-loop for x across [1 2] and y = (- (or x 0))
+ collect (cons x y))
'((1 . 0) (2 . -1)))))
(ert-deftest cl-macs-loop-destructure ()