0.8.19.18:
authorChristophe Rhodes <csr21@cam.ac.uk>
Mon, 7 Feb 2005 11:49:08 +0000 (11:49 +0000)
committerChristophe Rhodes <csr21@cam.ac.uk>
Mon, 7 Feb 2005 11:49:08 +0000 (11:49 +0000)
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.)

src/pcl/boot.lisp
tests/clos.impure.lisp
version.lisp-expr

index 4e3aa52..b49a1ab 100644 (file)
@@ -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
index 873e8cf..89fd5bb 100644 (file)
 (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)
index a69e3a9..8a08196 100644 (file)
@@ -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"