From: Juho Snellman Date: Wed, 1 Jun 2005 06:06:20 +0000 (+0000) Subject: 0.9.1.9: X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=70af994bbab490a2547bb61186f370e41332f3e5;p=sbcl.git 0.9.1.9: 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. --- diff --git a/NEWS b/NEWS index fc3e347..0061745 100644 --- 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 diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr index b45d0b3..dba38c8 100644 --- a/package-data-list.lisp-expr +++ b/package-data-list.lisp-expr @@ -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" diff --git a/src/code/condition.lisp b/src/code/condition.lisp index 4b62d88..39b93b0 100644 --- a/src/code/condition.lisp +++ b/src/code/condition.lisp @@ -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 () diff --git a/src/compiler/globaldb.lisp b/src/compiler/globaldb.lisp index b0decc0..b7d8630 100644 --- a/src/compiler/globaldb.lisp +++ b/src/compiler/globaldb.lisp @@ -162,9 +162,11 @@ ;; 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 ;;; @@ -277,6 +279,7 @@ define-info-type (&key (class (missing-arg)) (type (missing-arg)) (type-spec (missing-arg)) + (validate-function) default) (declare (type keyword class type)) `(progn @@ -304,6 +307,8 @@ ;; 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 @@ -845,6 +850,8 @@ &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 @@ -1220,7 +1227,13 @@ :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 @@ -1288,7 +1301,13 @@ (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 diff --git a/src/pcl/boot.lisp b/src/pcl/boot.lisp index 2f9d65f..b08d3a3 100644 --- a/src/pcl/boot.lisp +++ b/src/pcl/boot.lisp @@ -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 diff --git a/version.lisp-expr b/version.lisp-expr index 2e9dbf4..ca36793 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.1.8" +"0.9.1.9"