From: Christophe Rhodes <csr21@cam.ac.uk>
Date: Wed, 19 Jul 2006 11:13:00 +0000 (+0000)
Subject: 0.9.4.23:
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=1e4027886f4ec69649beb4e16797aea6ed8d72f2;p=sbcl.git

0.9.4.23:
	Allow specializer objects as specializers in DEFMETHOD
	... be a little bit more defensive when generating declarations
		for the method function.
	... peer suspiciously at the special case for SLOT-OBJECT, but
		leave it alone for now.
---

diff --git a/NEWS b/NEWS
index 0735ecf..306fc54 100644
--- a/NEWS
+++ b/NEWS
@@ -27,6 +27,9 @@ changes in sbcl-0.9.15 relative to sbcl-0.9.14:
     values of *print-case* could cause invalid output, due to 
     some internal special variables of the printer not being bound
     thread-locally (reported by Max Mikhanosha)
+  * fixed bug: SPECIALIZER metaobjects (including anonymous classes
+    and EQL-SPECIALIZERs) can be used as specializers to DEFMETHOD.
+    (reported by Pascal Costanza)
   * minor code generation optimizations:
     * better register allocation in CLOS dispatching functions
     * overflow detection when coercing signed bytes to fixnums on x86-64 
diff --git a/src/pcl/boot.lisp b/src/pcl/boot.lisp
index a1d2644..4dc4049 100644
--- a/src/pcl/boot.lisp
+++ b/src/pcl/boot.lisp
@@ -582,7 +582,7 @@ bootstrapping.
                  ;; SB-KERNEL:INSTANCE. In an effort to sweep such
                  ;; problems under the rug, we exclude these problem
                  ;; cases by blacklisting them here. -- WHN 2001-01-19
-                 '(slot-object))
+                 (list 'slot-object #+nil (find-class 'slot-object)))
          '(ignorable))
         ((not (eq *boot-state* 'complete))
          ;; KLUDGE: PCL, in its wisdom, sometimes calls methods with
@@ -591,6 +591,8 @@ bootstrapping.
          ;; second argument.) Hopefully it only does this kind of
          ;; weirdness when bootstrapping.. -- WHN 20000610
          '(ignorable))
+        ((typep specializer 'eql-specializer)
+         `(type (eql ,(eql-specializer-object specializer)) ,parameter))
         ((var-globally-special-p parameter)
          ;; KLUDGE: Don't declare types for global special variables
          ;; -- our rebinding magic for SETQ cases don't work right
@@ -614,7 +616,9 @@ bootstrapping.
          ;; least #.(find-class 'integer) and integer as equivalent
          ;; specializers with this.
          (let* ((specializer (if (and (typep specializer 'class)
-                                      (eq specializer (find-class (class-name specializer))))
+                                      (let ((name (class-name specializer)))
+                                        (and name (symbolp name)
+                                             (eq specializer (find-class name nil)))))
                                  (class-name specializer)
                                  specializer))
                 (kind (info :type :kind specializer)))
diff --git a/tests/mop.impure.lisp b/tests/mop.impure.lisp
index e69a1ea..b7af0cf 100644
--- a/tests/mop.impure.lisp
+++ b/tests/mop.impure.lisp
@@ -486,4 +486,18 @@
 (defclass foo () ())
 (reinitialize-instance (find-class 'foo) :name '(a b))
 
+;;; classes (including anonymous ones) and eql-specializers should be
+;;; allowed to be specializers.
+(defvar *anonymous-class*
+  (make-instance 'standard-class 
+                 :direct-superclasses (list (find-class 'standard-object))))
+(defvar *object-of-anonymous-class*
+  (make-instance *anonymous-class*))
+(eval `(defmethod method-on-anonymous-class ((obj ,*anonymous-class*)) 41))
+(assert (eql (method-on-anonymous-class *object-of-anonymous-class*) 41))
+(eval `(defmethod method-on-anonymous-class 
+        ((obj ,(intern-eql-specializer *object-of-anonymous-class*))) 
+        42))
+(assert (eql (method-on-anonymous-class *object-of-anonymous-class*) 42))
+
 ;;;; success
diff --git a/version.lisp-expr b/version.lisp-expr
index e3d7748..d92ce8e 100644
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"0.9.14.22"
+"0.9.14.23"