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

[Noam Postavsky]

Tino Calancha <tino.calancha@gmail.com> writes:

> (require 'cl-lib)
> (let* ((size 7)
>        (arr (make-vector size 0)))
>   (cl-loop for k below size
>            for x = (* 2 k) and y = (1+ (elt arr k))
>            collect (list k x y)))
>
>
> When you execute the form above it fails because
> the loop overrun `arr'.

A simpler example:

    (require 'cl-lib)
    (cl-loop for k below 3
         for x = (progn (message "k = %d" k) 1)
         and y = 1)

prints

    k = 0
    k = 1
    k = 2
    k = 3

in *Messages*.  The expansion looks like this:

    (cl-block nil
      (let* ((k 0))
        (let ((x nil)
              (y nil))
          (let* ((--cl-var-- t))
            (while (< k 3)
              (cl-psetq x
                        (if --cl-var--
                            (progn
                              (message "k = %d" k)
                              1)
                          x)
                        y (if --cl-var-- 1 y))
              (setq k (+ k 1))
              (cl-psetq x (progn
                            (message "k = %d" k)
                            1)
                        y 1)
              (setq --cl-var-- nil))
            nil))))

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.

--- i/lisp/emacs-lisp/cl-macs.el
+++ w/lisp/emacs-lisp/cl-macs.el
@@ -1288,7 +1288,7 @@ cl--parse-loop-clause
                       (then (if (eq (car cl--loop-args) 'then)
                                  (cl--pop2 cl--loop-args) start)))
                  (push (list var nil) loop-for-bindings)
-                 (if (or ands (eq (car cl--loop-args) 'and))
+                 (if nil ;(or ands (eq (car cl--loop-args) 'and))
                      (progn
                        (push `(,var
                                (if ,(or cl--loop-first-flag