0.9.1.9:
authorJuho Snellman <jsnell@iki.fi>
Wed, 1 Jun 2005 06:06:20 +0000 (06:06 +0000)
committerJuho Snellman <jsnell@iki.fi>
Wed, 1 Jun 2005 06:06:20 +0000 (06:06 +0000)
Fix a few ansi-test failures. Symbols can't be both the name of
        a type and the name of a declaration (ANSI 3.8.21).

        * Add a validate-function slot into the globaldb TYPE-INFO
          structure. If defined, the function is called from (SETF INFO)
          before SET-INFO-VALUE.
        * Define validation functions for (INFO :TYPE :KIND) and
          (INFO :DECLARATION :RECOGNIZED).
        * Remove (DECLAIM (DECLARATION CLASS)) from PCL. As far as I
          can see, PCL uses %CLASS for its internal declarations these
          days.

NEWS
package-data-list.lisp-expr
src/code/condition.lisp
src/compiler/globaldb.lisp
src/pcl/boot.lisp
version.lisp-expr

diff --git a/NEWS b/NEWS
index fc3e347..0061745 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -13,6 +13,8 @@ changes in sbcl-0.9.2 relative to sbcl-0.9.1:
   * fixed some bugs revealed by Paul Dietz' test suite:
     ** Invalid dotted lists no longer raise a read error when 
        *READ-SUPPRESS* is T
+    ** Signal an error if a symbol that names a declaration is used
+       as the name of a type, or vice versa
 
 changes in sbcl-0.9.1 relative to sbcl-0.9.0:
   * fixed cross-compiler leakages that prevented building a 32-bit
index b45d0b3..dba38c8 100644 (file)
@@ -1176,7 +1176,8 @@ is a good idea, but see SB-SYS re. blurring of boundaries."
                "CSUBTYPEP" "CTYPE" "TYPE-HASH-VALUE" "CTYPE-OF"
                "CTYPE-P" "CTYPEP" "CURRENT-FP" "CURRENT-SP"
                "CURRENT-DYNAMIC-SPACE-START" "DATA-VECTOR-REF"
-               "DATA-VECTOR-SET" "DECODE-DOUBLE-FLOAT"
+               "DATA-VECTOR-SET" "DECLARATION-TYPE-CONFLICT-ERROR"
+              "DECODE-DOUBLE-FLOAT"
                #!+long-float "DECODE-LONG-FLOAT"
                "DECODE-SINGLE-FLOAT"
                "DEFINED-FTYPE-MATCHES-DECLARED-FTYPE-P"
index 4b62d88..39b93b0 100644 (file)
@@ -1119,6 +1119,13 @@ SB-EXT:PACKAGE-LOCKED-ERROR-SYMBOL."))
 
 (define-condition timeout (serious-condition) ())
 
+(define-condition declaration-type-conflict-error (reference-condition
+                                                  simple-error)
+  ()
+  (:default-initargs
+      :format-control "symbol ~S cannot be both the name of a type and the name of a declaration"
+    :references (list '(:ansi-cl :section (3 8 21)))))
+
 ;;; Single stepping conditions
 
 (define-condition step-condition ()
index b0decc0..b7d8630 100644 (file)
   ;; a number that uniquely identifies this type (and implicitly its class)
   (number (missing-arg) :type type-number)
   ;; a type specifier which info of this type must satisfy
-  (type nil :type t)
+  (type nil :type t)  
   ;; a function called when there is no information of this type
-  (default (lambda () (error "type not defined yet")) :type function))
+  (default (lambda () (error "type not defined yet")) :type function)
+  ;; called by (SETF INFO) before calling SET-INFO-VALUE
+  (validate-function nil :type (or function null)))
 
 ;;; a map from class names to CLASS-INFO structures
 ;;;
     define-info-type (&key (class (missing-arg))
                           (type (missing-arg))
                           (type-spec (missing-arg))
+                          (validate-function)
                           default)
   (declare (type keyword class type))
   `(progn
        ;; values differ in the use of SB!XC symbols instead of CL
        ;; symbols.)
        (push `(let ((type-info (type-info-or-lose ,',class ,',type)))
+               (setf (type-info-validate-function type-info)
+                     ,',validate-function)
                (setf (type-info-default type-info)
                       ;; FIXME: This code is sort of nasty. It would
                       ;; be cleaner if DEFAULT accepted a real
                    &optional (env-list nil env-list-p))
   (let* ((info (type-info-or-lose class type))
         (tin (type-info-number info)))
+    (when (type-info-validate-function info)
+      (funcall (type-info-validate-function info) name new-value))
     (if env-list-p
        (set-info-value name
                        tin
   :type :kind
   :type-spec (member :primitive :defined :instance
                     :forthcoming-defclass-type nil)
-  :default nil)
+  :default nil
+  :validate-function (lambda (name new-value)
+                      (declare (ignore new-value)
+                               (notinline info))
+                      (when (info :declaration :recognized name)
+                        (error 'declaration-type-conflict-error
+                               :format-arguments (list name)))))
 
 ;;; the expander function for a defined type
 (define-info-type
 (define-info-type
   :class :declaration
   :type :recognized
-  :type-spec boolean)
+  :type-spec boolean
+  :validate-function (lambda (name new-value)
+                      (declare (ignore new-value)
+                               (notinline info))
+                      (when (info :type :kind name)
+                        (error 'declaration-type-conflict-error
+                               :format-arguments (list name)))))
 
 (define-info-class :alien-type)
 (define-info-type
index 2f9d65f..b08d3a3 100644 (file)
@@ -68,16 +68,6 @@ bootstrapping.
 
 |#
 
-;;; FIXME: As of sbcl-0.6.9.10, PCL still uses this nonstandard type
-;;; of declaration internally. It would be good to figure out how to
-;;; get rid of it, or failing that, (1) document why it's needed and
-;;; (2) use a private symbol with a forbidding name which suggests
-;;; it's not to be messed with by the user (e.g. SB-PCL:%CLASS)
-;;; instead of the too-inviting CLASS. (I tried just deleting the
-;;; declarations in MAKE-METHOD-LAMBDA-INTERNAL ca. sbcl-0.6.9.10, but
-;;; then things break.)
-(declaim (declaration class))
-
 (declaim (notinline make-a-method
                    add-named-method
                    ensure-generic-function-using-class
index 2e9dbf4..ca36793 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.9.1.8"
+"0.9.1.9"