From: Christophe Rhodes <csr21@cam.ac.uk>
Date: Mon, 7 Feb 2005 11:49:08 +0000 (+0000)
Subject: 0.8.19.18:
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=9ef9a441ee2d6471b4480572667d1e84e1e3e7e7;p=sbcl.git

0.8.19.18:
	Fix bug from PCL depessimization -- it is possible to get :DEFINED for
	:TYPE :KIND, but probably only for built-in-classes.

	(Hm, actually, it might be possible to get there through some bizarre
	combination of DEFTYPE and DEFCLASS.)
---

diff --git a/src/pcl/boot.lisp b/src/pcl/boot.lisp
index 4e3aa52..b49a1ab 100644
--- a/src/pcl/boot.lisp
+++ b/src/pcl/boot.lisp
@@ -612,9 +612,16 @@ bootstrapping.
 	 '(ignorable))
 	(t
 	 ;; Otherwise, we can usually make Python very happy.
-	 (let ((type (info :type :kind specializer)))
-	   (ecase type
+	 (let ((kind (info :type :kind specializer)))
+	   (ecase kind
 	     ((:primitive) `(type ,specializer ,parameter))
+	     ((:defined) 
+	      ;; some BUILT-IN-CLASSes (e.g. REAL) are also :DEFINED
+	      ;; types.  Nothing else should be.
+	      (let ((class (find-class specializer nil)))
+		(aver class)
+		(aver (typep class 'built-in-class)))
+	      `(type ,specializer ,parameter))
 	     ((:instance nil)
 	      (let ((class (find-class specializer nil)))
 		(cond
diff --git a/tests/clos.impure.lisp b/tests/clos.impure.lisp
index 873e8cf..89fd5bb 100644
--- a/tests/clos.impure.lisp
+++ b/tests/clos.impure.lisp
@@ -865,5 +865,42 @@
 (setf (find-class 'fr-alt) (find-class 'fr-super))
 (assert (eq (find-class 'fr-alt) (find-class 'fr-super)))
 
+
+;;; ANSI Figure 4-8: all defined classes.  Check that we can define
+;;; methods on all of these.
+(progn
+  (defgeneric method-for-defined-classes (x))
+  (dolist (c '(arithmetic-error 
+	       generic-function simple-error array hash-table 
+	       simple-type-error 
+	       bit-vector integer simple-warning             
+	       broadcast-stream list standard-class             
+	       built-in-class logical-pathname standard-generic-function  
+	       cell-error method standard-method            
+	       character method-combination standard-object            
+	       class null storage-condition          
+	       complex number stream                     
+	       concatenated-stream package stream-error               
+	       condition package-error string                     
+	       cons parse-error string-stream              
+	       control-error pathname structure-class            
+	       division-by-zero print-not-readable structure-object           
+	       echo-stream program-error style-warning              
+	       end-of-file random-state symbol                     
+	       error ratio synonym-stream             
+	       file-error rational t                          
+	       file-stream reader-error two-way-stream             
+	       float readtable type-error                 
+	       floating-point-inexact real unbound-slot               
+	       floating-point-invalid-operation restart unbound-variable
+	       floating-point-overflow sequence undefined-function 
+	       floating-point-underflow serious-condition vector 
+	       function simple-condition warning))
+    (eval `(defmethod method-for-defined-classes ((x ,c)) (princ x))))
+  (assert (string= (with-output-to-string (*standard-output*)
+		     (method-for-defined-classes #\3))
+		   "3")))
+	     
+
 ;;;; success
 (sb-ext:quit :unix-status 104)
diff --git a/version.lisp-expr b/version.lisp-expr
index a69e3a9..8a08196 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.8.19.17"
+"0.8.19.18"