Browse files

	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
  • Loading branch information...
csrhodes committed Nov 15, 2002
1 parent 7ffdb2f commit 89f1990cfd886b8ea3706de9f5b9215fbe7310b6
Showing with 31 additions and 35 deletions.
  1. +0 −19 BUGS
  2. +3 −0 NEWS
  3. +10 −14 src/code/loop.lisp
  4. +4 −1 src/code/target-package.lisp
  5. +13 −0 tests/loop.pure.lisp
  6. +1 −1 version.lisp-expr
@@ -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-,
@@ -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
@@ -1614,12 +1614,6 @@ code to be loaded.
((and using-allowed (loop-tequal token 'using))
(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*))
@@ -1759,7 +1753,7 @@ code to be loaded.
(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
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))
`(((,variable nil ,data-type) (,pkg-var ,(cadar prep-phrases)))
@@ -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*))
@@ -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)
(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))
@@ -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 comments on commit 89f1990

Please sign in to comment.