procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Revert "cl-loop: Calculate the array length just once"

Browse source 
It fails when using 'and' (parallel bindings) for arrays (Bug#40727).
* lisp/emacs-lisp/cl-macs.el (cl--parse-loop-clause): Revert to
recomputing array length.
* test/lisp/emacs-lisp/cl-macs-tests.el (cl-macs-loop-and-arrays): New
test.
This commit is contained in:
Noam Postavsky 2020-04-30 07:54:49 -04:00
parent 2c905fb8a1
commit de7158598f
2 changed files with 10 additions and 10 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

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

@ -1317,13 +1317,11 @@ For more details, see Info node `(cl)Loop Facility'.
((memq word '(across across-ref))
(let ((temp-vec (make-symbol "--cl-vec--"))
(temp-len (make-symbol "--cl-len--"))
(temp-idx (make-symbol "--cl-idx--")))
(push (list temp-vec (pop cl--loop-args)) loop-for-bindings)
(push (list temp-len `(length ,temp-vec)) loop-for-bindings)
(push (list temp-idx -1) loop-for-bindings)
(cl--push-clause-loop-body
`(< (setq ,temp-idx (1+ ,temp-idx)) ,temp-len))
`(< (setq ,temp-idx (1+ ,temp-idx)) (length ,temp-vec)))
(if (eq word 'across-ref)
(push (list var `(aref ,temp-vec ,temp-idx))
cl--loop-symbol-macs)
@ -1337,7 +1335,6 @@ For more details, see Info node `(cl)Loop Facility'.
(error "Expected `of'"))))
(seq (cl--pop2 cl--loop-args))
(temp-seq (make-symbol "--cl-seq--"))
(temp-len (make-symbol "--cl-len--"))
(temp-idx
(if (eq (car cl--loop-args) 'using)
(if (and (= (length (cadr cl--loop-args)) 2)
@ -1348,19 +1345,16 @@ For more details, see Info node `(cl)Loop Facility'.
(push (list temp-seq seq) loop-for-bindings)
(push (list temp-idx 0) loop-for-bindings)
(if ref
(progn
(let ((temp-len (make-symbol "--cl-len--")))
(push (list temp-len `(length ,temp-seq))
loop-for-bindings)
(push (list var `(elt ,temp-seq ,temp-idx))
cl--loop-symbol-macs)
(cl--push-clause-loop-body `(< ,temp-idx ,temp-len)))
;; Evaluate seq length just if needed, that is, when seq is not a cons.
(push (list temp-len (or (consp seq) `(length ,temp-seq)))
loop-for-bindings)
(cl--push-clause-loop-body `(< ,temp-idx ,temp-len)))
(push (list var nil) loop-for-bindings)
(cl--push-clause-loop-body `(and ,temp-seq
(or (consp ,temp-seq)
(< ,temp-idx ,temp-len))))
(< ,temp-idx (length ,temp-seq)))))
(push (list var `(if (consp ,temp-seq)
(pop ,temp-seq)
(aref ,temp-seq ,temp-idx)))

6
test/lisp/emacs-lisp/cl-macs-tests.el
View file

@ -39,6 +39,12 @@
collect (list c b a))
'((4.0 2 1) (8.3 6 5) (10.4 9 8)))))
(ert-deftest cl-macs-loop-and-arrays ()
"Bug#40727"
(should (equal (cl-loop for y = (- (or x 0)) and x across [1 2]
collect (cons x y))
'((1 . 0) (2 . -1)))))
(ert-deftest cl-macs-loop-destructure ()
(should (equal (cl-loop for (a b c) in '((1 2 4.0) (5 6 8.3) (8 9 10.4))
collect (list c b a))