From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.io!.POSTED.ciao.gmane.io!not-for-mail From: Noam Postavsky Newsgroups: gmane.emacs.bugs Subject: bug#40727: 27.0.91; 'cl-loop ... across ... and' seems broken Date: Thu, 30 Apr 2020 19:40:43 -0400 Message-ID: <87v9lgmtj8.fsf@gmail.com> References: <871ro5nojr.fsf@gmail.com> Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Injection-Info: ciao.gmane.io; posting-host="ciao.gmane.io:159.69.161.202"; logging-data="43869"; mail-complaints-to="usenet@ciao.gmane.io" User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/27.0.91 (gnu/linux) Cc: 40727@debbugs.gnu.org, Tino Calancha To: Philipp Stephani Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Fri May 01 01:46:27 2020 Return-path: Envelope-to: geb-bug-gnu-emacs@m.gmane-mx.org Original-Received: from lists.gnu.org ([209.51.188.17]) by ciao.gmane.io with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.92) (envelope-from ) id 1jUIss-000BFT-Ew for geb-bug-gnu-emacs@m.gmane-mx.org; Fri, 01 May 2020 01:46:26 +0200 Original-Received: from localhost ([::1]:39960 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1jUIsr-00010k-BN for geb-bug-gnu-emacs@m.gmane-mx.org; Thu, 30 Apr 2020 19:46:25 -0400 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]:48672) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1jUIrE-0008U4-VC for bug-gnu-emacs@gnu.org; Thu, 30 Apr 2020 19:46:16 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.90_1) (envelope-from ) id 1jUIog-0008Co-2x for bug-gnu-emacs@gnu.org; Thu, 30 Apr 2020 19:44:44 -0400 Original-Received: from debbugs.gnu.org ([209.51.188.43]:36386) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1jUIoc-000850-Lc for bug-gnu-emacs@gnu.org; Thu, 30 Apr 2020 19:42:03 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1jUIoc-0000SF-C6 for bug-gnu-emacs@gnu.org; Thu, 30 Apr 2020 19:42:02 -0400 X-Loop: help-debbugs@gnu.org Resent-From: Noam Postavsky Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Thu, 30 Apr 2020 23:42:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 40727 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: confirmed Original-Received: via spool by 40727-submit@debbugs.gnu.org id=B40727.15882900751684 (code B ref 40727); Thu, 30 Apr 2020 23:42:02 +0000 Original-Received: (at 40727) by debbugs.gnu.org; 30 Apr 2020 23:41:15 +0000 Original-Received: from localhost ([127.0.0.1]:47932 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1jUInq-0000R4-Fa for submit@debbugs.gnu.org; Thu, 30 Apr 2020 19:41:15 -0400 Original-Received: from mail-qv1-f43.google.com ([209.85.219.43]:44652) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1jUInn-0000Qn-AV for 40727@debbugs.gnu.org; Thu, 30 Apr 2020 19:41:13 -0400 Original-Received: by mail-qv1-f43.google.com with SMTP id ck5so3981606qvb.11 for <40727@debbugs.gnu.org>; Thu, 30 Apr 2020 16:41:11 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20161025; h=from:to:cc:subject:references:date:in-reply-to:message-id :user-agent:mime-version; bh=63wY5GZLczNCZnlbsNqOwDLYEuBBoO4v6xOp3OVfJlw=; b=OhUHLQFeQdE5CYTiHKTcEbKgGZ8JumWudHHBfau/5iLiRnkh8YvVP81okIbkgqW/rw /uY5Z/a2upC2X7l6v3K1rpHPMOUQ0h+EAITCzPQvtftbK+kqCBTMkUi+7FZq6y6lXKVW 4h59h4qZoV9Ei4rNOvb3qdEeNHg1fdGK5r2vQwSWpR5QEvBgpvLtbKeaa6qcwLsWYPrr 74jawmX0poChtITuxC5gPaMOBaaIFJludfhEu+h8x2rHhT+YuZdm8rEoA1whmL8Nx9r2 OG+Y3XG64aBLYOFLFZneaf/uinfZzhzEVYALxnLnRGMmbUPjhq8LbMhBh+aTHYMBeTzt huAw== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20161025; h=x-gm-message-state:from:to:cc:subject:references:date:in-reply-to :message-id:user-agent:mime-version; bh=63wY5GZLczNCZnlbsNqOwDLYEuBBoO4v6xOp3OVfJlw=; b=kl7C/GolUkF2n+KZBk11w3KROiCDQ56u+4qTHNqem/XnpePKaW1UX5vbUsc6cyoUYE CyN4SmXipoTkgaUWoecO/RA/cEHChUpnhKXxOGSCkFx1pG32KRLLa8WpziqdZxs2N/3R COjE+dcm2UabiJayIGEdS5QJnAxLeIF816EBRgt9JQnIPFkwQHqQzLc+f9xT7WA5P0jW BY9OqqD0DWrtpEpgpskbGJi7W3uWtA/EJvxwpNMmq9dfXltddYk9dGURGGCR6vOl8dae nnThP9xXNhB0f3eLHkN9NmpZdqmRq3y/H314DKsSvpbwgmh95CWUKTyny7Bvm6MtV/ue w+tg== X-Gm-Message-State: AGi0PuZhSJYXlo/YX+ICJ1LMuJcMv7U4F7TSux5xG1Mo3bvxiBxEVtbI 4By6fZX4k6IWV1A+tTJ39ho= X-Google-Smtp-Source: APiQypIcbtYBxF7CYJ0yQCOGYaDEX3jn7s3ZKNpRILxsIf+jGsR4N0LnOgdBBDlFMsO17G7XjJ2jtA== X-Received: by 2002:a0c:f781:: with SMTP id s1mr1532853qvn.182.1588290065575; Thu, 30 Apr 2020 16:41:05 -0700 (PDT) Original-Received: from minid (cbl-45-2-119-47.yyz.frontiernetworks.ca. [45.2.119.47]) by smtp.gmail.com with ESMTPSA id y6sm1330788qky.133.2020.04.30.16.40.54 (version=TLS1_2 cipher=ECDHE-ECDSA-CHACHA20-POLY1305 bits=256/256); Thu, 30 Apr 2020 16:41:00 -0700 (PDT) In-Reply-To: <871ro5nojr.fsf@gmail.com> (Noam Postavsky's message of "Thu, 30 Apr 2020 08:30:48 -0400") X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-Received-From: 209.51.188.43 X-BeenThere: bug-gnu-emacs@gnu.org List-Id: "Bug reports for GNU Emacs, the Swiss army knife of text editors" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Original-Sender: "bug-gnu-emacs" Xref: news.gmane.io gmane.emacs.bugs:179406 Archived-At: --=-=-= Content-Type: text/plain Noam Postavsky 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). --=-=-= Content-Type: text/plain Content-Disposition: attachment; filename=0002-Don-t-increment-array-index-in-cl-loop-twice-Bug-407.patch Content-Description: patch >From 62d4626a1684ec7fd7d560cdf75f1b6a5f726c37 Mon Sep 17 00:00:00 2001 From: Noam Postavsky 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 --=-=-= Content-Type: text/plain 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: --=-=-= Content-Type: text/plain Content-Disposition: attachment; filename=0001-Revert-Refix-conditional-step-clauses-in-cl-loop.patch Content-Description: patch >From 431d7ebc466163808535706cbb4929b25e5b4fbc Mon Sep 17 00:00:00 2001 From: Noam Postavsky 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 --=-=-= Content-Type: text/plain Content-Disposition: attachment; filename=0002-Revert-cl-loop-Add-missing-guard-condition.patch Content-Description: patch >From 8982a0756c7fc4e1cffd3989509fd243989f946c Mon Sep 17 00:00:00 2001 From: Noam Postavsky 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 --=-=-= Content-Type: text/plain Content-Disposition: attachment; filename=0003-Revert-cl-loop-Calculate-the-array-length-just-once.patch Content-Description: patch >From 338c67f58b80462b02620cf77f16cb11770786c0 Mon Sep 17 00:00:00 2001 From: Noam Postavsky 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 --=-=-= Content-Type: text/plain Content-Disposition: attachment; filename=0004-Mark-Bug-29799-tests-as-failing-since-we-reverted-th.patch Content-Description: patch >From 36c48b5c21278c0f42be31b7253bfed7f698b479 Mon Sep 17 00:00:00 2001 From: Noam Postavsky 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 --=-=-=--