[Top][All Lists]

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

bug#29799: 24.5; cl-loop guard clause missing

From: Tino Calancha
Subject: bug#29799: 24.5; cl-loop guard clause missing
Date: Wed, 03 Jan 2018 19:34:51 +0900
User-agent: Gnus/5.13 (Gnus v5.13) Emacs/27.0.50 (gnu/linux)

Noam Postavsky <address@hidden> writes:

> Noam Postavsky <address@hidden> writes:
>> I don't understand why the "then" step is put at the of the loop.  The
>> following patch (commenting out the "ands" branch) avoids doing that,
>> and fixes this bug.  But presumably there is some reason for having this
>> code in the first place?  I guess some more complicated example would be
>> needed to show why this naive fix won't work.
> Oh, 'make -C test cl-macs-tests' provides some.  And I see we've in fact
> been over this naive solution before:
> https://debbugs.gnu.org/cgi/bugreport.cgi?bug=6583#28
Bug#6583 requires more thinking; I couldn't find a satisfactory fix for

For Bug#29799 I propose the patch below:
* It adds a new variable `cl--loop-guard-cond'
* In a for clause, rigth after update the loop var, check if
  the loop condition is still valid before update the remaining
  AFAIS, this is similar to the CL expansions for these cases.

--8<-----------------------------cut here---------------start------------->8---
commit 25fb3aad45ea3c545c6389c4f7bb6f1a76ebffe8
Author: Tino Calancha <address@hidden>
Date:   Wed Jan 3 19:15:14 2018 +0900

    Fix #Bug#29799
    * lisp/emacs-lisp/cl-macs.el (cl--loop-guard-cond): New variable.
    (cl--parse-loop-clause): Set it non-nil if the loop contains
    a for/as clause.
    (cl-loop): After update the loop variable, update other variables
    only if cl--loop-guard-cond is non-nil.
    * test/lisp/emacs-lisp/cl-macs-tests.el (cl-macs-loop-for-as-equals-and):
    New test.

diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index f5311041cc..db1b811f38 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -892,7 +892,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
@@ -961,7 +961,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-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:
@@ -996,7 +996,22 @@ cl-loop
                              (list (or cl--loop-result-explicit
             (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 
+                 ;; i.e. (car ands), is still satisfied; otherwise do not
+                 ;; update other variables (#Bug#29799).
+                 ;; (last cl--loop-steps) updates the loop var
+                 ;; (car (butlast cl--loop-steps)) sets `cl--loop-first-flag' 
+                 ;; (nreverse (cdr (butlast cl--loop-steps))) sets the
+                 ;; remaining variables.
+                 (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
@@ -1500,10 +1515,11 @@ cl--parse-loop-clause
                      ,(cl--loop-let (nreverse loop-for-sets) 'setq ands)
-       (if loop-for-steps
-           (push (cons (if ands 'cl-psetq 'setq)
-                       (apply 'append (nreverse loop-for-steps)))
-                 cl--loop-steps))))
+       (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))))
      ((eq word 'repeat)
       (let ((temp (make-symbol "--cl-var--")))
diff --git a/test/lisp/emacs-lisp/cl-macs-tests.el 
index 575f170af6..2aab002964 100644
--- a/test/lisp/emacs-lisp/cl-macs-tests.el
+++ b/test/lisp/emacs-lisp/cl-macs-tests.el
@@ -497,4 +497,12 @@
                           vconcat (vector (1+ x)))
                  [2 3 4 5 6])))
+(ert-deftest cl-macs-loop-for-as-equals-and ()
+  "Test for https://debbugs.gnu.org/29799 ."
+  (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)
+                            collect (list k x))))))
 ;;; cl-macs-tests.el ends here

--8<-----------------------------cut here---------------end--------------->8---

reply via email to

[Prev in Thread] Current Thread [Next in Thread]