From 94f6cba24107c886c787c5a5c1231d87ff1b888e Mon Sep 17 00:00:00 2001 From: Christophe Rhodes Date: Tue, 5 Nov 2002 16:36:34 +0000 Subject: [PATCH] 0.7.9.31: Fix bug (from GCL's ANSI test suite): ... LOOP now signals PROGRAM-ERROR on syntactical errors --- NEWS | 2 ++ src/code/loop.lisp | 7 +++---- tests/loop.pure.lisp | 10 ++++++++++ version.lisp-expr | 2 +- 4 files changed, 16 insertions(+), 5 deletions(-) diff --git a/NEWS b/NEWS index 01fdb25..02bd302 100644 --- a/NEWS +++ b/NEWS @@ -1374,6 +1374,8 @@ changes in sbcl-0.7.10 relative to sbcl-0.7.9: :FROM-END ** ELT signals an error of type TYPE-ERROR when the index argument is not a valid sequence index; + ** LOOP signals (at macroexpansion time) an error of type + PROGRAM-ERROR when duplicate variable names are found; * fixed bug 166: compiler preserves "there is a way to go" invariant when deleting code. * fixed bug 172: macro lambda lists with required arguments after diff --git a/src/code/loop.lisp b/src/code/loop.lisp index ed24692..93132de 100644 --- a/src/code/loop.lisp +++ b/src/code/loop.lisp @@ -737,10 +737,9 @@ code to be loaded. ((eq l (cdr *loop-source-code*)) (nreverse new)))) (defun loop-error (format-string &rest format-args) - (error "~?~%current LOOP context:~{ ~S~}." - format-string - format-args - (loop-context))) + (error 'sb!int:simple-program-error + :format-control "~?~%current LOOP context:~{ ~S~}." + :format-arguments (list format-string format-args (loop-context)))) (defun loop-warn (format-string &rest format-args) (warn "~?~%current LOOP context:~{ ~S~}." diff --git a/tests/loop.pure.lisp b/tests/loop.pure.lisp index 66f7f34..23f6691 100644 --- a/tests/loop.pure.lisp +++ b/tests/loop.pure.lisp @@ -54,3 +54,13 @@ (print t)))) (declare (ignore function warnings-p)) (assert failure-p)) + +;;; a bug reported by Paul F. Dietz (in his ANSI test suite): +;;; duplicate bindings in LOOP must signal errors of type +;;; PROGRAM-ERROR. +(assert (typep (nth-value 1 + (ignore-errors + (funcall (lambda () + (loop for (a . a) in '((1 . 2) (3 . 4)) + return a))))) + 'program-error)) \ No newline at end of file diff --git a/version.lisp-expr b/version.lisp-expr index 8751e86..02b1f5b 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.9.30" +"0.7.9.31" -- 1.7.10.4