GNU bug report logs - #29799
24.5; cl-loop guard clause missing

Previous Next

Full log

Message #14 received at 29799 <at> debbugs.gnu.org (full text, mbox):

From: Tino Calancha <tino.calancha <at> gmail.com>
To: Noam Postavsky <npostavs <at> users.sourceforge.net>
Cc: 29799 <at> debbugs.gnu.org, monnier <at> iro.umontreal.ca
Subject: Re: bug#29799: 24.5; cl-loop guard clause missing
Date: Wed, 03 Jan 2018 19:34:51 +0900

Noam Postavsky <npostavs <at> users.sourceforge.net> writes:

> Noam Postavsky <npostavs <at> users.sourceforge.net> 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
it.

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
  variables.
  AFAIS, this is similar to the CL expansions for these cases.

--8<-----------------------------cut here---------------start------------->8---
commit 25fb3aad45ea3c545c6389c4f7bb6f1a76ebffe8
Author: Tino Calancha <tino.calancha <at> gmail.com>
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
                                         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 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' nil
+                 ;; (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)
                      t)
                   cl--loop-body))
-	(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 b/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---

Previous Next

GNU bug tracking system
Copyright (C) 1999 Darren O. Benham, 1997,2003 nCipher Corporation Ltd, 1994-97 Ian Jackson.