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 (file)
--- 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
-      #<STANDARD-GENERIC-FUNCTION FOO (1)>.
-  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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (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.9.50"
+"0.7.9.51"