From: Christophe Rhodes Date: Fri, 15 Nov 2002 15:21:57 +0000 (+0000) Subject: 0.7.9.51: X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=89f1990cfd886b8ea3706de9f5b9215fbe7310b6;p=sbcl.git 0.7.9.51: Fix some LOOP bugs reported by Paul Dietz cmucl-imp ... NIL is an ignored variable name Minor frobs ... loop.lisp now compiles without style-warnings ... signal a package error in duplicate package logic --- diff --git a/BUGS b/BUGS index 7b6595f..c746255 100644 --- a/BUGS +++ b/BUGS @@ -979,25 +979,6 @@ WORKAROUND: (see bug 203) -193: "unhelpful CLOS error reporting when the primary method is missing" - In sbcl-0.7.7, when - (defmethod foo :before ((x t)) (print x)) - is the only method defined on FOO, the error reporting when e.g. - (foo 12) - is relatively unhelpful: - There is no primary method for the generic function - #. - with the offending argument nowhere visible in the backtrace. This - continues even if there *are* primary methods, just not for the - specified arg type, e.g. - (defmethod foo ((x character)) (print x)) - (defmethod foo ((x string)) (print x)) - (defmethod foo ((x pathname)) ...) - In that case it could be very helpful to know what argument value is - falling through the cracks of the defined primary methods, but the - error message stays the same (even BACKTRACE doesn't tell you what the - bad argument value is). - 194: "no error from (THE REAL '(1 2 3)) in some cases" fixed parts: a. In sbcl-0.7.7.9, diff --git a/NEWS b/NEWS index 8bbf18f..92ee4a4 100644 --- a/NEWS +++ b/NEWS @@ -1410,6 +1410,9 @@ changes in sbcl-0.7.10 relative to sbcl-0.7.9: * fixed bug 136: CALL-NEXT-METHOD no longer gets confused when arguments are lexically rebound. (thanks to Gerd Moellmann and Pierre Mai) + * fixed bug 194: error messages are now more informative when there + is no primary method applicable in a call to a generic + function. (thanks to Gerd Moellmann) planned incompatible changes in 0.7.x: * When the profiling interface settles down, maybe in 0.7.x, maybe diff --git a/src/code/loop.lisp b/src/code/loop.lisp index 5cc3347..10a92ec 100644 --- a/src/code/loop.lisp +++ b/src/code/loop.lisp @@ -1614,12 +1614,6 @@ code to be loaded. ((and using-allowed (loop-tequal token 'using)) (loop-pop-source) (do ((z (loop-pop-source) (loop-pop-source)) (tem)) (nil) - (when (or (atom z) - (atom (cdr z)) - (not (null (cddr z))) - (not (symbolp (car z))) - (and (cadr z) (not (symbolp (cadr z))))) - (loop-error "~S bad variable pair in path USING phrase" z)) (when (cadr z) (if (setq tem (loop-tassoc (car z) *loop-named-vars*)) (loop-error @@ -1759,7 +1753,7 @@ code to be loaded. sequence-type element-type) (multiple-value-bind (indexv) (loop-named-var 'index) - (let ((sequencev (named-var 'sequence))) + (let ((sequencev (loop-named-var 'sequence))) (list* nil nil ; dummy bindings and prologue (loop-sequencer indexv 'fixnum @@ -1779,7 +1773,7 @@ code to be loaded. ||# (defun loop-hash-table-iteration-path (variable data-type prep-phrases - &key (which (missing-arg))) + &key (which (sb!int:missing-arg))) (declare (type (member :hash-key :hash-value) which)) (cond ((or (cdr prep-phrases) (not (member (caar prep-phrases) '(:in :of)))) (loop-error "too many prepositions!")) @@ -1800,11 +1794,12 @@ code to be loaded. ;; dummy NILs into MULTIPLE-VALUE-SETQ variable lists. (setq other-p t dummy-predicate-var (loop-when-it-var)) - (let ((key-var nil) - (val-var nil) - (bindings `((,variable nil ,data-type) - (,ht-var ,(cadar prep-phrases)) - ,@(and other-p other-var `((,other-var nil)))))) + (let* ((key-var nil) + (val-var nil) + (variable (or variable (gensym "LOOP-HASH-VAR-TEMP-"))) + (bindings `((,variable nil ,data-type) + (,ht-var ,(cadar prep-phrases)) + ,@(and other-p other-var `((,other-var nil)))))) (ecase which (:hash-key (setq key-var variable val-var (and other-p other-var))) @@ -1838,7 +1833,8 @@ code to be loaded. (unless (symbolp variable) (loop-error "Destructuring is not valid for package symbol iteration.")) (let ((pkg-var (gensym "LOOP-PKGSYM-")) - (next-fn (gensym "LOOP-PKGSYM-NEXT-"))) + (next-fn (gensym "LOOP-PKGSYM-NEXT-")) + (variable (or variable (gensym "LOOP-PKGSYM-VAR-")))) (push `(with-package-iterator (,next-fn ,pkg-var ,@symbol-types)) *loop-wrappers*) `(((,variable nil ,data-type) (,pkg-var ,(cadar prep-phrases))) diff --git a/src/code/target-package.lisp b/src/code/target-package.lisp index a8a8ea7..2e4d9eb 100644 --- a/src/code/target-package.lisp +++ b/src/code/target-package.lisp @@ -355,7 +355,10 @@ (name (string name)) (found (find-package name))) (unless (or (not found) (eq found package)) - (error "A package named ~S already exists." name)) + (error 'simple-package-error + :package name + :format-control "A package named ~S already exists." + :format-arguments (list name))) (remhash (package-%name package) *package-names*) (dolist (n (package-%nicknames package)) (remhash n *package-names*)) diff --git a/tests/loop.pure.lisp b/tests/loop.pure.lisp index 5275cc4..77653bc 100644 --- a/tests/loop.pure.lisp +++ b/tests/loop.pure.lisp @@ -67,3 +67,16 @@ ;;; similar to gcl/ansi-test LOOP.1.27, and fixed at the same time: (assert (equal (loop for x downto 7 by 2 from 13 collect x) '(13 11 9 7))) + +;;; some more from gcl/ansi-test: +(let ((table (make-hash-table))) + (setf (gethash 'foo table) '(bar baz)) + (assert (= (loop for nil being the hash-keys of table count t) 1)) + (assert (equal (loop for nil being the hash-keys of table + using (hash-value (v1 . v2)) + when v1 + return v2) + '(baz)))) + +(assert (= (loop for nil being the external-symbols of :cl count t) 978)) +(assert (= (loop for x being the external-symbols of :cl count x) 977)) diff --git a/version.lisp-expr b/version.lisp-expr index f8a9047..09f572a 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.50" +"0.7.9.51"