From: Christophe Rhodes Date: Wed, 27 Nov 2002 17:08:30 +0000 (+0000) Subject: 0.7.10.2: X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=cb4f56b0581f77e20a7d8cb593891c7bd919c3e9;p=sbcl.git 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 --- 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 --- 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))) (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 --- 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 --- 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"