aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorNoam Postavsky2020-04-30 18:55:40 -0400
committerNoam Postavsky2020-05-07 08:23:56 -0400
commitddc8020327604b92e7e830708933f62a22f48f62 (patch)
treecfe881705093a9c4c1e726e4909a57abaf59ddf2
parentde7158598fcd5440c0180ff6f83052c29e490bcd (diff)
downloademacs-ddc8020327604b92e7e830708933f62a22f48f62.tar.gz
emacs-ddc8020327604b92e7e830708933f62a22f48f62.zip
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.
-rw-r--r--lisp/emacs-lisp/cl-macs.el3
-rw-r--r--test/lisp/emacs-lisp/cl-macs-tests.el3
2 files changed, 5 insertions, 1 deletions
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index fef8786b599..3317c580028 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'.
1320 (temp-idx (make-symbol "--cl-idx--"))) 1320 (temp-idx (make-symbol "--cl-idx--")))
1321 (push (list temp-vec (pop cl--loop-args)) loop-for-bindings) 1321 (push (list temp-vec (pop cl--loop-args)) loop-for-bindings)
1322 (push (list temp-idx -1) loop-for-bindings) 1322 (push (list temp-idx -1) loop-for-bindings)
1323 (push `(setq ,temp-idx (1+ ,temp-idx)) cl--loop-body)
1323 (cl--push-clause-loop-body 1324 (cl--push-clause-loop-body
1324 `(< (setq ,temp-idx (1+ ,temp-idx)) (length ,temp-vec))) 1325 `(< ,temp-idx (length ,temp-vec)))
1325 (if (eq word 'across-ref) 1326 (if (eq word 'across-ref)
1326 (push (list var `(aref ,temp-vec ,temp-idx)) 1327 (push (list var `(aref ,temp-vec ,temp-idx))
1327 cl--loop-symbol-macs) 1328 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 77609a42a99..983e79ac57c 100644
--- a/test/lisp/emacs-lisp/cl-macs-tests.el
+++ b/test/lisp/emacs-lisp/cl-macs-tests.el
@@ -43,6 +43,9 @@
43 "Bug#40727" 43 "Bug#40727"
44 (should (equal (cl-loop for y = (- (or x 0)) and x across [1 2] 44 (should (equal (cl-loop for y = (- (or x 0)) and x across [1 2]
45 collect (cons x y)) 45 collect (cons x y))
46 '((1 . 0) (2 . -1))))
47 (should (equal (cl-loop for x across [1 2] and y = (- (or x 0))
48 collect (cons x y))
46 '((1 . 0) (2 . -1))))) 49 '((1 . 0) (2 . -1)))))
47 50
48(ert-deftest cl-macs-loop-destructure () 51(ert-deftest cl-macs-loop-destructure ()