0.7.10.2:

	Fix remaining LOOP bugs from GCL ansi-tests
	... duplicate variable names (at any level) signal an error at
		macroexpansion time;
	... IT is only a special loop symbol in the first clause of a
		conditional execution clause.

diff --git a/NEWS b/NEWS
index 19c6806..e3b8953 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -1432,10 +1432,15 @@ changes in sbcl-0.7.10 relative to sbcl-0.7.9:
     SXHASH-related changes in the layout of CLOS data structures
 
 changes in sbcl-0.7.11 relative to sbcl-0.7.10:
-  * fixed some bugs shown by Paul Dietz' test suite:
+  * fixed some more bugs revealed by Paul Dietz' test suite:
     ** As required by ANSI, LOOP now disallows anonymous collection
        clauses such as COLLECT I in conjunction with aggregate boolean
        clauses such as THEREIS (= I 1);
+    ** LOOP now signals an error when any variable is reused in the
+       same loop (including the potentially useful construct analogous
+       to WITH A = 1 WITH A = (1+ A);
+    ** IT is only a special loop symbol within the first clause of a
+       conditional loop clause;
 
 planned incompatible changes in 0.7.x:
   * (not done yet, but planned:) When the profiling interface settles

diff --git a/src/code/loop.lisp b/src/code/loop.lisp
index 18f08ac..23d714e 100644 (file)
--- a/src/code/loop.lisp
+++ b/src/code/loop.lisp
@@ -1013,6 +1013,13 @@ code to be loaded.
          *loop-desetq-crocks* nil
          *loop-wrappers* nil)))
 
+(defun loop-var-p (name)
+  (do ((entry *loop-bind-stack* (cdr entry)))
+      (nil)
+    (cond
+      ((null entry) (return nil))
+      ((assoc name (caar entry) :test #'eq) (return t)))))
+
 (defun loop-make-var (name initialization dtype &optional iteration-var-p)
   (cond ((null name)
         (cond ((not (null initialization))
@@ -1075,7 +1082,10 @@ code to be loaded.
       (loop-make-var (gensym "LOOP-BIND-") form data-type)))
 \f
 (defun loop-do-if (for negatep)
-  (let ((form (loop-get-form)) (*loop-inside-conditional* t) (it-p nil))
+  (let ((form (loop-get-form))
+       (*loop-inside-conditional* t)
+       (it-p nil)
+       (first-clause-p t))
     (flet ((get-clause (for)
             (do ((body nil)) (nil)
               (let ((key (car *loop-source-code*)) (*loop-body* nil) data)
@@ -1085,7 +1095,8 @@ code to be loaded.
                          key for))
                       (t (setq *loop-source-context* *loop-source-code*)
                          (loop-pop-source)
-                         (when (loop-tequal (car *loop-source-code*) 'it)
+                         (when (and (loop-tequal (car *loop-source-code*) 'it)
+                                    first-clause-p)
                            (setq *loop-source-code*
                                  (cons (or it-p
                                            (setq it-p
@@ -1100,6 +1111,7 @@ code to be loaded.
                                   "~S does not introduce a LOOP clause that can follow ~S."
                                   key for))
                                (t (setq body (nreconc *loop-body* body)))))))
+              (setq first-clause-p nil)
               (if (loop-tequal (car *loop-source-code*) :and)
                   (loop-pop-source)
                   (return (if (cdr body)
@@ -1169,6 +1181,8 @@ code to be loaded.
     (let ((cruft (find (the symbol name) *loop-collection-cruft*
                       :key #'loop-collector-name)))
       (cond ((not cruft)
+            (when (and name (loop-var-p name))
+              (loop-error "Variable ~S in INTO clause is a duplicate" name))
             (push (setq cruft (make-loop-collector
                                 :name name :class class
                                 :history (list collector) :dtype dtype))
@@ -1304,6 +1318,8 @@ code to be loaded.
                     (loop-pop-source)
                     (loop-get-form))
                    (t nil)))
+    (when (and var (loop-var-p var))
+      (loop-error "Variable ~S has already been used" var))
     (loop-make-var var val dtype)
     (if (loop-tequal (car *loop-source-code*) :and)
        (loop-pop-source)

diff --git a/tests/loop.pure.lisp b/tests/loop.pure.lisp
index 7e6d4ce..278fa4c 100644 (file)
--- a/tests/loop.pure.lisp
+++ b/tests/loop.pure.lisp
@@ -146,4 +146,28 @@
     (ignore-errors
       (loop for i in '(1 2 3) thereis (= i 3) collect i))
   (assert (null result))
-  (assert (typep error 'program-error)))
\ No newline at end of file
+  (assert (typep error 'program-error)))
+
+(multiple-value-bind (result error)
+    (ignore-errors
+      (loop with i = 1 for x from 1 to 3 collect x into i))
+  (assert (null result))
+  (assert (typep error 'program-error)))
+(multiple-value-bind (result error)
+    ;; this one has a plausible interpretation in terms of LET*, but
+    ;; ANSI seems specifically to disallow it
+    (ignore-errors
+      (loop with i = 1 with i = (1+ i)
+           for x from 1 to 3
+           collect (+ x i)))
+  (assert (null result))
+  (assert (typep error 'program-error)))
+
+(let ((it 'z))
+  (assert (equal
+          ;; this one just seems weird.  Nevertheless...
+          (loop for i in '(a b c d)
+                when i
+                  collect it
+                  and collect it)
+          '(a z b z c z d z))))

diff --git a/version.lisp-expr b/version.lisp-expr
index 6f57564..07b2178 100644 (file)
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -18,4 +18,4 @@
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
 
-"0.7.10.1"
+"0.7.10.2"