* bug#40727: 27.0.91; 'cl-loop ... across ... and' seems broken
@ 2020-04-20 0:33 Philipp Stephani
2020-04-30 12:30 ` Noam Postavsky
0 siblings, 1 reply; 6+ messages in thread
From: Philipp Stephani @ 2020-04-20 0:33 UTC (permalink / raw)
To: 40727
In Emacs 26:
emacs -Q -batch -l cl-lib -eval '(cl-loop for x across [1 2] and y across [3 4])'
works (i.e. no error), but in Emacs 27 it gives an error
Symbol’s value as variable is void: --cl-vec--
This doesn't happen with "for" instead of "and", and also doesn't happen
with lists and "in". If it helps, here's the backtrace:
(length --cl-vec--)
(let ((--cl-vec-- [1 2]) (--cl-len-- (length --cl-vec--)) (--cl-idx-- -1) (x nil) (--cl-vec-- [3 4]) (--cl-len-- (length --cl-vec--)) (--cl-idx-- -1) (y nil)) (while (and (< (setq --cl-idx-- (1+ --cl-idx--)) --cl-len--) (< (setq --cl-idx-- (1+ --cl-idx--)) --cl-len--)) (cl-psetq x (aref --cl-vec-- --cl-idx--) y (aref --cl-vec-- --cl-idx--))) nil)
(catch '--cl-block-nil-- (let ((--cl-vec-- [1 2]) (--cl-len-- (length --cl-vec--)) (--cl-idx-- -1) (x nil) (--cl-vec-- [3 4]) (--cl-len-- (length --cl-vec--)) (--cl-idx-- -1) (y nil)) (while (and (< (setq --cl-idx-- (1+ --cl-idx--)) --cl-len--) (< (setq --cl-idx-- (1+ --cl-idx--)) --cl-len--)) (cl-psetq x (aref --cl-vec-- --cl-idx--) y (aref --cl-vec-- --cl-idx--))) nil))
(cl--block-wrapper (catch '--cl-block-nil-- (let ((--cl-vec-- [1 2]) (--cl-len-- (length --cl-vec--)) (--cl-idx-- -1) (x nil) (--cl-vec-- [3 4]) (--cl-len-- (length --cl-vec--)) (--cl-idx-- -1) (y nil)) (while (and (< (setq --cl-idx-- (1+ --cl-idx--)) --cl-len--) (< (setq --cl-idx-- (1+ --cl-idx--)) --cl-len--)) (cl-psetq x (aref --cl-vec-- --cl-idx--) y (aref --cl-vec-- --cl-idx--))) nil)))
(cl-block nil (let ((--cl-vec-- [1 2]) (--cl-len-- (length --cl-vec--)) (--cl-idx-- -1) (x nil) (--cl-vec-- [3 4]) (--cl-len-- (length --cl-vec--)) (--cl-idx-- -1) (y nil)) (while (and (< (setq --cl-idx-- (1+ --cl-idx--)) --cl-len--) (< (setq --cl-idx-- (1+ --cl-idx--)) --cl-len--)) (cl-psetq x (aref --cl-vec-- --cl-idx--) y (aref --cl-vec-- --cl-idx--))) nil))
(cl-loop for x across [1 2] and y across [3 4])
eval((cl-loop for x across [1 2] and y across [3 4]) t)
command-line-1(("-f" "toggle-debug-on-error" "-l" "cl-lib" "-eval" "(cl-loop for x across [1 2] and y across [3 4])"))
command-line()
normal-top-level()
In GNU Emacs 27.0.91 (build 3, x86_64-pc-linux-gnu, GTK+ Version 3.24.13)
of 2020-04-20
Repository revision: a1040861f118881004f59866111f64cd0ae03b7a
Repository branch: emacs-27
Windowing system distributor 'The X.Org Foundation', version 11.0.12004000
System Description: Debian GNU/Linux rodete
Recent messages:
For information about GNU Emacs and the GNU system, type C-h C-a.
Configured using:
'configure --enable-checking=all --enable-gtk-deprecation-warnings
--enable-gcc-warnings=warn-only --enable-check-lisp-object-type
--with-mailutils --without-pop 'CFLAGS=-O0 -g3' LDFLAGS=-g3'
Configured features:
XPM JPEG TIFF GIF PNG SOUND DBUS GSETTINGS GLIB NOTIFY INOTIFY
LIBSELINUX GNUTLS FREETYPE HARFBUZZ XFT ZLIB TOOLKIT_SCROLL_BARS GTK3
X11 XDBE XIM MODULES THREADS PDUMPER GMP
Important settings:
value of $LANG: en_US.UTF-8
locale-coding-system: utf-8-unix
Major mode: Lisp Interaction
Minor modes in effect:
tooltip-mode: t
global-eldoc-mode: t
eldoc-mode: t
electric-indent-mode: t
mouse-wheel-mode: t
tool-bar-mode: t
menu-bar-mode: t
file-name-shadow-mode: t
global-font-lock-mode: t
font-lock-mode: t
blink-cursor-mode: t
auto-composition-mode: t
auto-encryption-mode: t
auto-compression-mode: t
line-number-mode: t
transient-mark-mode: t
Load-path shadows:
None found.
Features:
(shadow sort mail-extr emacsbug message rmc dired dired-loaddefs
format-spec rfc822 mml easymenu mml-sec epa epg epg-config gnus-util
rmail rmail-loaddefs text-property-search time-date mm-decode mm-bodies
mm-encode mail-parse rfc2231 mailabbrev gmm-utils mailheader sendmail
rfc2047 rfc2045 ietf-drums mm-util mail-prsvr mail-utils phst skeleton
derived edmacro kmacro pcase ffap thingatpt url url-proxy url-privacy
url-expand url-methods url-history url-cookie url-domsuf url-util
url-parse auth-source cl-seq eieio eieio-core cl-macs eieio-loaddefs
password-cache json map url-vars mailcap subr-x rx gnutls puny seq
byte-opt gv bytecomp byte-compile cconv dbus xml cl-loaddefs cl-lib
tooltip eldoc electric uniquify ediff-hook vc-hooks lisp-float-type
mwheel term/x-win x-win term/common-win x-dnd tool-bar dnd fontset image
regexp-opt fringe tabulated-list replace newcomment text-mode elisp-mode
lisp-mode prog-mode register page tab-bar menu-bar rfn-eshadow isearch
timer select scroll-bar mouse jit-lock font-lock syntax facemenu
font-core term/tty-colors frame minibuffer cl-generic cham georgian
utf-8-lang misc-lang vietnamese tibetan thai tai-viet lao korean
japanese eucjp-ms cp51932 hebrew greek romanian slovak czech european
ethiopic indian cyrillic chinese composite charscript charprop
case-table epa-hook jka-cmpr-hook help simple abbrev obarray
cl-preloaded nadvice loaddefs button faces cus-face macroexp files
text-properties overlay sha1 md5 base64 format env code-pages mule
custom widget hashtable-print-readable backquote threads dbusbind
inotify dynamic-setting system-font-setting font-render-setting
move-toolbar gtk x-toolkit x multi-tty make-network-process emacs)
Memory information:
((conses 16 63095 5761)
(symbols 48 8435 1)
(strings 32 22388 1823)
(string-bytes 1 711569)
(vectors 16 12506)
(vector-slots 8 174130 5982)
(floats 8 25 34)
(intervals 56 201 0)
(buffers 1000 12))
--
Google Germany GmbH
Erika-Mann-Straße 33
80636 München
Registergericht und -nummer: Hamburg, HRB 86891
Sitz der Gesellschaft: Hamburg
Geschäftsführer: Paul Manicle, Halimah DeLaine Prado
If you received this communication by mistake, please don’t forward it to
anyone else (it may contain confidential or privileged information), please
erase all copies of it, including all attachments, and please let the sender
know it went to the wrong person. Thanks.
^ permalink raw reply [flat|nested] 6+ messages in thread
* bug#40727: 27.0.91; 'cl-loop ... across ... and' seems broken
2020-04-20 0:33 bug#40727: 27.0.91; 'cl-loop ... across ... and' seems broken Philipp Stephani
@ 2020-04-30 12:30 ` Noam Postavsky
2020-04-30 23:40 ` Noam Postavsky
0 siblings, 1 reply; 6+ messages in thread
From: Noam Postavsky @ 2020-04-30 12:30 UTC (permalink / raw)
To: Philipp Stephani; +Cc: 40727, Tino Calancha
[-- Attachment #1: Type: text/plain, Size: 1020 bytes --]
tags 40727 + confirmed
quit
Philipp Stephani <p.stephani2@gmail.com> writes:
> In Emacs 26:
>
> emacs -Q -batch -l cl-lib -eval '(cl-loop for x across [1 2] and y across [3 4])'
>
> works (i.e. no error), but in Emacs 27 it gives an error
>
> Symbol’s value as variable is void: --cl-vec--
>
> This doesn't happen with "for" instead of "and", and also doesn't happen
> with lists and "in".
It's because of [1: bfca19e475]. I think it should be possible to fix
by grouping the bindings put into 'loop-for-bindings', but meanwhile we
should revert that change, at least on the release branch. It doesn't
revert automatically because there was meanwhile another change to use
'cl--push-clause-loop-body' instead of 'push' on the involved lines, but
after manual fixup your example works correctly.
[1: bfca19e475]: 2018-01-08 00:33:15 +0900
cl-loop: Calculate the array length just once
https://git.savannah.gnu.org/cgit/emacs.git/commit/?id=bfca19e475c01f13dbacc7f8b7bb1aecf46cb7e4
[-- Attachment #2: patch --]
[-- Type: text/plain, Size: 3922 bytes --]
From 56a55199614b60e5ffd2968217a0d115779bb23d Mon Sep 17 00:00:00 2001
From: Noam Postavsky <npostavs@gmail.com>
Date: Thu, 30 Apr 2020 07:54:49 -0400
Subject: [PATCH] Revert "cl-loop: Calculate the array length just once"
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.
---
lisp/emacs-lisp/cl-macs.el | 14 ++++----------
test/lisp/emacs-lisp/cl-macs-tests.el | 6 ++++++
2 files changed, 10 insertions(+), 10 deletions(-)
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index d56f4151df..20bd1883c3 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -1322,13 +1322,11 @@ cl--parse-loop-clause
((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)
@@ -1342,7 +1340,6 @@ cl--parse-loop-clause
(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)
@@ -1353,19 +1350,16 @@ cl--parse-loop-clause
(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)))
diff --git a/test/lisp/emacs-lisp/cl-macs-tests.el b/test/lisp/emacs-lisp/cl-macs-tests.el
index 9ca84f156a..77609a42a9 100644
--- a/test/lisp/emacs-lisp/cl-macs-tests.el
+++ b/test/lisp/emacs-lisp/cl-macs-tests.el
@@ -39,6 +39,12 @@ cl-macs-loop-and-assignment
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))
--
2.11.0
[-- Attachment #3: Type: text/plain, Size: 164 bytes --]
By the way, while adding the test case I found an additional regression
involving loop termination by a 'var = ...' clause. I'll open another
bug about it soon.
^ permalink raw reply related [flat|nested] 6+ messages in thread
* bug#40727: 27.0.91; 'cl-loop ... across ... and' seems broken
2020-04-30 12:30 ` Noam Postavsky
@ 2020-04-30 23:40 ` Noam Postavsky
2020-05-01 6:11 ` Eli Zaretskii
0 siblings, 1 reply; 6+ messages in thread
From: Noam Postavsky @ 2020-04-30 23:40 UTC (permalink / raw)
To: Philipp Stephani; +Cc: 40727, Tino Calancha
[-- Attachment #1: Type: text/plain, Size: 600 bytes --]
Noam Postavsky <npostavs@gmail.com> writes:
> By the way, while adding the test case I found an additional regression
> involving loop termination by a 'var = ...' clause. I'll open another
> bug about it soon.
Actually, it's very closely connected (only observable after fixing the
original bug, since otherwise the necessary conditions trigger the
--cl-vec-- is void error), so I'll keep it here. When there is a
(cl-loop for VAR across ARRAY and VAR2 = ...) the array index would get
incremented twice per loop. Fixed by the patch below (applies on top of
the patch in my previous message).
[-- Attachment #2: patch --]
[-- Type: text/plain, Size: 2046 bytes --]
From 62d4626a1684ec7fd7d560cdf75f1b6a5f726c37 Mon Sep 17 00:00:00 2001
From: Noam Postavsky <npostavs@gmail.com>
Date: Thu, 30 Apr 2020 18:55:40 -0400
Subject: [PATCH 2/2] 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 20bd1883c3..d6997ce0d2 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -1325,8 +1325,9 @@ cl--parse-loop-clause
(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 77609a42a9..983e79ac57 100644
--- a/test/lisp/emacs-lisp/cl-macs-tests.el
+++ b/test/lisp/emacs-lisp/cl-macs-tests.el
@@ -43,6 +43,9 @@ 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))))
+ (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 ()
--
2.11.0
[-- Attachment #3: Type: text/plain, Size: 143 bytes --]
Eli, is it okay to push both of these to emacs-27? Alternatively,
reverting both fixes to Bug#29799 in addition to the Bug#29866 fix
works:
[-- Attachment #4: patch --]
[-- Type: text/plain, Size: 9439 bytes --]
From 431d7ebc466163808535706cbb4929b25e5b4fbc Mon Sep 17 00:00:00 2001
From: Noam Postavsky <npostavs@gmail.com>
Date: Thu, 30 Apr 2020 19:33:34 -0400
Subject: [PATCH 1/4] Revert "Refix conditional step clauses in cl-loop"
This reverts commit 045cfbef09a67c334e4772cb045181cf2203d839.
---
lisp/emacs-lisp/cl-macs.el | 96 ++++++++++++++++++++++++++++------------------
1 file changed, 59 insertions(+), 37 deletions(-)
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index d56f4151df..cda25d186f 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -889,7 +889,7 @@ cl-return-from
;;; The "cl-loop" macro.
(defvar cl--loop-args) (defvar cl--loop-accum-var) (defvar cl--loop-accum-vars)
-(defvar cl--loop-bindings) (defvar cl--loop-body) (defvar cl--loop-conditions)
+(defvar cl--loop-bindings) (defvar cl--loop-body)
(defvar cl--loop-finally)
(defvar cl--loop-finish-flag) ;Symbol set to nil to exit the loop?
(defvar cl--loop-first-flag)
@@ -897,7 +897,7 @@ cl--loop-initially
(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
@@ -966,8 +966,7 @@ cl-loop
(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-conditions 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:
;;
@@ -1002,7 +1001,24 @@ cl-loop
(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
@@ -1035,12 +1051,6 @@ cl-loop
(list `(cl-symbol-macrolet ,cl--loop-symbol-macs ,@body))))
`(cl-block ,cl--loop-name ,@body)))))
-(defmacro cl--push-clause-loop-body (clause)
- "Apply CLAUSE to both `cl--loop-conditions' and `cl--loop-body'."
- `(progn
- (push ,clause cl--loop-conditions)
- (push ,clause cl--loop-body)))
-
;; Below is a complete spec for cl-loop, in several parts that correspond
;; to the syntax given in CLtL2. The specs do more than specify where
;; the forms are; it also specifies, as much as Edebug allows, all the
@@ -1191,6 +1201,8 @@ cl--push-clause-loop-body
;; (def-edebug-spec loop-d-type-spec
;; (&or (loop-d-type-spec . [&or nil loop-d-type-spec]) cl-type-spec))
+
+
(defun cl--parse-loop-clause () ; uses loop-*
(let ((word (pop cl--loop-args))
(hash-types '(hash-key hash-keys hash-value hash-values))
@@ -1269,11 +1281,11 @@ cl--parse-loop-clause
(if end-var (push (list end-var end) loop-for-bindings))
(if step-var (push (list step-var step)
loop-for-bindings))
- (when end
- (cl--push-clause-loop-body
- (list
- (if down (if excl '> '>=) (if excl '< '<=))
- var (or end-var end))))
+ (if end
+ (push (list
+ (if down (if excl '> '>=) (if excl '< '<=))
+ var (or end-var end))
+ cl--loop-body))
(push (list var (list (if down '- '+) var
(or step-var step 1)))
loop-for-steps)))
@@ -1283,7 +1295,7 @@ cl--parse-loop-clause
(temp (if (and on (symbolp var))
var (make-symbol "--cl-var--"))))
(push (list temp (pop cl--loop-args)) loop-for-bindings)
- (cl--push-clause-loop-body `(consp ,temp))
+ (push `(consp ,temp) cl--loop-body)
(if (eq word 'in-ref)
(push (list var `(car ,temp)) cl--loop-symbol-macs)
(or (eq temp var)
@@ -1306,19 +1318,24 @@ cl--parse-loop-clause
((eq word '=)
(let* ((start (pop cl--loop-args))
(then (if (eq (car cl--loop-args) 'then)
- (cl--pop2 cl--loop-args) start))
- (first-assign (or cl--loop-first-flag
- (setq cl--loop-first-flag
- (make-symbol "--cl-var--")))))
+ (cl--pop2 cl--loop-args) start)))
(push (list var nil) loop-for-bindings)
(if (or ands (eq (car cl--loop-args) 'and))
(progn
- (push `(,var (if ,first-assign ,start ,var)) loop-for-sets)
- (push `(,var (if ,(car (cl--loop-build-ands
- (nreverse cl--loop-conditions)))
- ,then ,var))
- loop-for-steps))
- (push `(,var (if ,first-assign ,start ,then)) loop-for-sets))))
+ (push `(,var
+ (if ,(or cl--loop-first-flag
+ (setq cl--loop-first-flag
+ (make-symbol "--cl-var--")))
+ ,start ,var))
+ loop-for-sets)
+ (push (list var then) loop-for-steps))
+ (push (list var
+ (if (eq start then) start
+ `(if ,(or cl--loop-first-flag
+ (setq cl--loop-first-flag
+ (make-symbol "--cl-var--")))
+ ,start ,then)))
+ loop-for-sets))))
((memq word '(across across-ref))
(let ((temp-vec (make-symbol "--cl-vec--"))
@@ -1327,8 +1344,9 @@ cl--parse-loop-clause
(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))
+ (push `(< (setq ,temp-idx (1+ ,temp-idx))
+ ,temp-len)
+ cl--loop-body)
(if (eq word 'across-ref)
(push (list var `(aref ,temp-vec ,temp-idx))
cl--loop-symbol-macs)
@@ -1358,14 +1376,15 @@ cl--parse-loop-clause
loop-for-bindings)
(push (list var `(elt ,temp-seq ,temp-idx))
cl--loop-symbol-macs)
- (cl--push-clause-loop-body `(< ,temp-idx ,temp-len)))
+ (push `(< ,temp-idx ,temp-len) cl--loop-body))
;; 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)
(push (list var nil) loop-for-bindings)
- (cl--push-clause-loop-body `(and ,temp-seq
- (or (consp ,temp-seq)
- (< ,temp-idx ,temp-len))))
+ (push `(and ,temp-seq
+ (or (consp ,temp-seq)
+ (< ,temp-idx ,temp-len)))
+ cl--loop-body)
(push (list var `(if (consp ,temp-seq)
(pop ,temp-seq)
(aref ,temp-seq ,temp-idx)))
@@ -1461,8 +1480,9 @@ cl--parse-loop-clause
(push (list var '(selected-frame))
loop-for-bindings)
(push (list temp nil) loop-for-bindings)
- (cl--push-clause-loop-body `(prog1 (not (eq ,var ,temp))
- (or ,temp (setq ,temp ,var))))
+ (push `(prog1 (not (eq ,var ,temp))
+ (or ,temp (setq ,temp ,var)))
+ cl--loop-body)
(push (list var `(next-frame ,var))
loop-for-steps)))
@@ -1483,8 +1503,9 @@ cl--parse-loop-clause
(push (list minip `(minibufferp (window-buffer ,var)))
loop-for-bindings)
(push (list temp nil) loop-for-bindings)
- (cl--push-clause-loop-body `(prog1 (not (eq ,var ,temp))
- (or ,temp (setq ,temp ,var))))
+ (push `(prog1 (not (eq ,var ,temp))
+ (or ,temp (setq ,temp ,var)))
+ cl--loop-body)
(push (list var `(next-window ,var ,minip))
loop-for-steps)))
@@ -1508,6 +1529,7 @@ cl--parse-loop-clause
t)
cl--loop-body))
(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))))
--
2.11.0
[-- Attachment #5: patch --]
[-- Type: text/plain, Size: 3297 bytes --]
From 8982a0756c7fc4e1cffd3989509fd243989f946c Mon Sep 17 00:00:00 2001
From: Noam Postavsky <npostavs@gmail.com>
Date: Thu, 30 Apr 2020 19:33:50 -0400
Subject: [PATCH 2/4] Revert "cl-loop: Add missing guard condition"
This reverts commit a0365437c9ee308ad7978e436631020f513b25e7.
---
lisp/emacs-lisp/cl-macs.el | 32 +++++++-------------------------
1 file changed, 7 insertions(+), 25 deletions(-)
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index cda25d186f..00f34d3fb6 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -897,7 +897,7 @@ cl--loop-initially
(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-guard-cond)
+(defvar cl--loop-symbol-macs)
(defun cl--loop-set-iterator-function (kind iterator)
(if cl--loop-iterator-function
@@ -966,7 +966,7 @@ cl-loop
(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-guard-cond nil))
+ (cl--loop-symbol-macs nil))
;; Here is more or less how those dynbind vars are used after looping
;; over cl--parse-loop-clause:
;;
@@ -1001,24 +1001,7 @@ cl-loop
(list (or cl--loop-result-explicit
cl--loop-result))))
(ands (cl--loop-build-ands (nreverse cl--loop-body)))
- (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)))))))
+ (while-body (nconc (cadr ands) (nreverse cl--loop-steps)))
(body (append
(nreverse cl--loop-initially)
(list (if cl--loop-iterator-function
@@ -1528,11 +1511,10 @@ cl--parse-loop-clause
,(cl--loop-let (nreverse loop-for-sets) 'setq ands)
t)
cl--loop-body))
- (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))))
+ (if loop-for-steps
+ (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--")))
--
2.11.0
[-- Attachment #6: patch --]
[-- Type: text/plain, Size: 2643 bytes --]
From 338c67f58b80462b02620cf77f16cb11770786c0 Mon Sep 17 00:00:00 2001
From: Noam Postavsky <npostavs@gmail.com>
Date: Thu, 30 Apr 2020 19:33:51 -0400
Subject: [PATCH 3/4] Revert "cl-loop: Calculate the array length just once"
This reverts commit bfca19e475c01f13dbacc7f8b7bb1aecf46cb7e4.
---
lisp/emacs-lisp/cl-macs.el | 12 +++---------
1 file changed, 3 insertions(+), 9 deletions(-)
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index 00f34d3fb6..78d083fcc6 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -1322,13 +1322,11 @@ cl--parse-loop-clause
((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)
(push `(< (setq ,temp-idx (1+ ,temp-idx))
- ,temp-len)
+ (length ,temp-vec))
cl--loop-body)
(if (eq word 'across-ref)
(push (list var `(aref ,temp-vec ,temp-idx))
@@ -1343,7 +1341,6 @@ cl--parse-loop-clause
(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)
@@ -1354,19 +1351,16 @@ cl--parse-loop-clause
(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)
(push `(< ,temp-idx ,temp-len) cl--loop-body))
- ;; 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)
(push (list var nil) loop-for-bindings)
(push `(and ,temp-seq
(or (consp ,temp-seq)
- (< ,temp-idx ,temp-len)))
+ (< ,temp-idx (length ,temp-seq))))
cl--loop-body)
(push (list var `(if (consp ,temp-seq)
(pop ,temp-seq)
--
2.11.0
[-- Attachment #7: patch --]
[-- Type: text/plain, Size: 1335 bytes --]
From 36c48b5c21278c0f42be31b7253bfed7f698b479 Mon Sep 17 00:00:00 2001
From: Noam Postavsky <npostavs@gmail.com>
Date: Thu, 30 Apr 2020 19:35:45 -0400
Subject: [PATCH 4/4] ; Mark Bug#29799 tests as failing since we reverted the
fix
* test/lisp/emacs-lisp/cl-macs-tests.el (cl-macs-loop-for-as-equals-and)
(cl-macs-loop-conditional-step-clauses): Set :expected-result to
:failed.
---
test/lisp/emacs-lisp/cl-macs-tests.el | 2 ++
1 file changed, 2 insertions(+)
diff --git a/test/lisp/emacs-lisp/cl-macs-tests.el b/test/lisp/emacs-lisp/cl-macs-tests.el
index 9ca84f156a..c357ecde95 100644
--- a/test/lisp/emacs-lisp/cl-macs-tests.el
+++ b/test/lisp/emacs-lisp/cl-macs-tests.el
@@ -498,6 +498,7 @@ cl-macs-loop-vconcat
(ert-deftest cl-macs-loop-for-as-equals-and ()
"Test for https://debbugs.gnu.org/29799 ."
+ :expected-result :failed
(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)
@@ -531,6 +532,7 @@ cl-macs-test--symbol-macrolet
(ert-deftest cl-macs-loop-conditional-step-clauses ()
"These tests failed under the initial fixes in #bug#29799."
+ :expected-result :failed
(should (cl-loop for i from 1 upto 100 and j = 1 then (1+ j)
if (not (= i j))
return nil
--
2.11.0
^ permalink raw reply related [flat|nested] 6+ messages in thread
* bug#40727: 27.0.91; 'cl-loop ... across ... and' seems broken
2020-04-30 23:40 ` Noam Postavsky
@ 2020-05-01 6:11 ` Eli Zaretskii
2020-05-06 1:16 ` Noam Postavsky
0 siblings, 1 reply; 6+ messages in thread
From: Eli Zaretskii @ 2020-05-01 6:11 UTC (permalink / raw)
To: Noam Postavsky; +Cc: 40727, p.stephani2, tino.calancha
> From: Noam Postavsky <npostavs@gmail.com>
> Date: Thu, 30 Apr 2020 19:40:43 -0400
> Cc: 40727@debbugs.gnu.org, Tino Calancha <tino.calancha@gmail.com>
>
> Eli, is it okay to push both of these to emacs-27? Alternatively,
> reverting both fixes to Bug#29799 in addition to the Bug#29866 fix
> works:
I prefer reverting, thanks.
^ permalink raw reply [flat|nested] 6+ messages in thread
* bug#40727: 27.0.91; 'cl-loop ... across ... and' seems broken
2020-05-01 6:11 ` Eli Zaretskii
@ 2020-05-06 1:16 ` Noam Postavsky
2020-05-09 23:13 ` Philipp Stephani
0 siblings, 1 reply; 6+ messages in thread
From: Noam Postavsky @ 2020-05-06 1:16 UTC (permalink / raw)
To: Eli Zaretskii; +Cc: 40727, p.stephani2, tino.calancha
tags 40727 fixed
close 40727 27.1
quit
Eli Zaretskii <eliz@gnu.org> writes:
>> From: Noam Postavsky <npostavs@gmail.com>
>> Date: Thu, 30 Apr 2020 19:40:43 -0400
>> Cc: 40727@debbugs.gnu.org, Tino Calancha <tino.calancha@gmail.com>
>>
>> Eli, is it okay to push both of these to emacs-27? Alternatively,
>> reverting both fixes to Bug#29799 in addition to the Bug#29866 fix
>> works:
>
> I prefer reverting, thanks.
Okay, I pushed those two to master, and reverted on emacs-27.
[1: 79e133da03]: 2020-05-05 21:07:58 -0400
Revert "Refix conditional step clauses in cl-loop"
https://git.savannah.gnu.org/cgit/emacs.git/commit/?id=79e133da034cd2d7cccfc5a6eb7db340f2dc45a8
[2: caf155c463]: 2020-05-05 21:07:58 -0400
Revert "cl-loop: Add missing guard condition"
https://git.savannah.gnu.org/cgit/emacs.git/commit/?id=caf155c4638d4704b2a099657153c9abc115720b
[3: de1b33f5a8]: 2020-05-05 21:07:58 -0400
Revert "cl-loop: Calculate the array length just once"
https://git.savannah.gnu.org/cgit/emacs.git/commit/?id=de1b33f5a8c6ceee9be59285f70370c3cb2efd34
[4: 1e09364d67]: 2020-05-05 21:07:58 -0400
; Mark Bug#29799 tests as failing since we reverted the fix
https://git.savannah.gnu.org/cgit/emacs.git/commit/?id=1e09364d677b0fb57efd18369c55e8c2d0e826f5
----
[5: 33c5dc3201]: 2020-05-05 21:05:26 -0400
Revert "cl-loop: Calculate the array length just once"
https://git.savannah.gnu.org/cgit/emacs.git/commit/?id=33c5dc3201c334703c951360dbc7e83b60db4456
[6: 721dad1829]: 2020-05-05 21:06:07 -0400
Don't increment array index in cl-loop twice (Bug#40727)
https://git.savannah.gnu.org/cgit/emacs.git/commit/?id=721dad1829d9c641acd31201b96a0ddf827f0c89
^ permalink raw reply [flat|nested] 6+ messages in thread
* bug#40727: 27.0.91; 'cl-loop ... across ... and' seems broken
2020-05-06 1:16 ` Noam Postavsky
@ 2020-05-09 23:13 ` Philipp Stephani
0 siblings, 0 replies; 6+ messages in thread
From: Philipp Stephani @ 2020-05-09 23:13 UTC (permalink / raw)
To: Noam Postavsky; +Cc: 40727-done, Tino Calancha
Am Mi., 6. Mai 2020 um 03:17 Uhr schrieb Noam Postavsky <npostavs@gmail.com>:
>
> tags 40727 fixed
> close 40727 27.1
> quit
>
> Eli Zaretskii <eliz@gnu.org> writes:
>
> >> From: Noam Postavsky <npostavs@gmail.com>
> >> Date: Thu, 30 Apr 2020 19:40:43 -0400
> >> Cc: 40727@debbugs.gnu.org, Tino Calancha <tino.calancha@gmail.com>
> >>
> >> Eli, is it okay to push both of these to emacs-27? Alternatively,
> >> reverting both fixes to Bug#29799 in addition to the Bug#29866 fix
> >> works:
> >
> > I prefer reverting, thanks.
>
> Okay, I pushed those two to master, and reverted on emacs-27.
>
Thanks. Confirmed that the problem doesn't happen any more on the
release branch.
^ permalink raw reply [flat|nested] 6+ messages in thread
end of thread, other threads:[~2020-05-09 23:13 UTC | newest]
Thread overview: 6+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2020-04-20 0:33 bug#40727: 27.0.91; 'cl-loop ... across ... and' seems broken Philipp Stephani
2020-04-30 12:30 ` Noam Postavsky
2020-04-30 23:40 ` Noam Postavsky
2020-05-01 6:11 ` Eli Zaretskii
2020-05-06 1:16 ` Noam Postavsky
2020-05-09 23:13 ` Philipp Stephani
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).