emacs-diffs
[Top][All Lists]
Advanced

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

[Emacs-diffs] master a036543: cl-loop: Add missing guard condition


From: Tino Calancha
Subject: [Emacs-diffs] master a036543: cl-loop: Add missing guard condition
Date: Mon, 8 Jan 2018 05:18:00 -0500 (EST)

branch: master
commit a0365437c9ee308ad7978e436631020f513b25e7
Author: Tino Calancha <address@hidden>
Commit: Tino Calancha <address@hidden>

    cl-loop: Add missing guard condition
    
    Consider the expansion of `cl-loop' with a `for' clause and more
    than one internal variables, X, Y, processed in parallel.
    Each step updates X and Y right after update the loop variable, K; if
    either X or Y depend on K, then some forms of the body are
    evaluated with the wrong K (Bug#29799).
    
    For instance, consider the following code:
    (cl-loop for k below 2
             for x = (progn (message "k = %d" k) 1)
             and y = 1)
    
    This code should show in *Messages*:
    k = 0
    k = 1
    
    Instead, the code shows:
    k = 0
    k = 1
    k = 2
    
    To prevent this we must ensure that the loop condition is still
    satisfied right after update the loop variable.
    In the macro expansion of the example above, right after:
    (setq k (+ k 1))
    
    evaluate the rest of the body forms iif the condition
    (< k 2)
    is still valid.
    
    * 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, evaluate the remaining of
    the body forms just if the loop condition is still valid (Bug#29799).
    
    * test/lisp/emacs-lisp/cl-macs-tests.el (cl-macs-loop-for-as-equals-and):
    New test.
---
 lisp/emacs-lisp/cl-macs.el            | 32 +++++++++++++++++++++++++-------
 test/lisp/emacs-lisp/cl-macs-tests.el |  8 ++++++++
 2 files changed, 33 insertions(+), 7 deletions(-)

diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index 9af014c..43eb426 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -892,7 +892,7 @@ This is compatible with Common Lisp, but note that `defun' 
and
 (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 @@ For more details, see Info node `(cl)Loop Facility'.
          (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,24 @@ For more details, see Info node `(cl)Loop Facility'.
                              (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
@@ -1506,10 +1523,11 @@ For more details, see Info node `(cl)Loop Facility'.
                      ,(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 f0bde7a..edb1530 100644
--- a/test/lisp/emacs-lisp/cl-macs-tests.el
+++ b/test/lisp/emacs-lisp/cl-macs-tests.el
@@ -497,4 +497,12 @@ collection clause."
                           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



reply via email to

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