From 1913e44aa31172eb3c345115a2acb367356f6b4b Mon Sep 17 00:00:00 2001 From: Nikodemus Siivola Date: Wed, 29 Aug 2007 17:14:45 +0000 Subject: [PATCH] 1.0.9.12: inform genesis about FOR-STD-CLASS-P slot in LAYOUT * It was left uninitialized by genesis, resulting in bogus results from LAYOUT-FOR-STD-CLASS-P. * Poke at it in tests. --- src/code/class.lisp | 7 +++++++ src/compiler/generic/genesis.lisp | 1 + tests/clos.impure.lisp | 6 ++++++ version.lisp-expr | 2 +- 4 files changed, 15 insertions(+), 1 deletion(-) diff --git a/src/code/class.lisp b/src/code/class.lisp index 6f8b8ca45..c1ece12fe 100644 --- a/src/code/class.lisp +++ b/src/code/class.lisp @@ -114,6 +114,13 @@ ;;; type checking and garbage collection. Whenever a class is ;;; incompatibly redefined, a new layout is allocated. If two object's ;;; layouts are EQ, then they are exactly the same type. +;;; +;;; *** IMPORTANT *** +;;; +;;; If you change the slots of LAYOUT, you need to alter genesis as +;;; well, since the initialization of layout slots is hardcoded there. +;;; +;;; FIXME: ...it would be better to automate this, of course... (def!struct (layout ;; KLUDGE: A special hack keeps this from being ;; called when building code for the diff --git a/src/compiler/generic/genesis.lisp b/src/compiler/generic/genesis.lisp index a8a454edf..a4ea9d5ab 100644 --- a/src/compiler/generic/genesis.lisp +++ b/src/compiler/generic/genesis.lisp @@ -959,6 +959,7 @@ core and return a descriptor to it." (cold-set-layout-slot result 'info *nil-descriptor*) (cold-set-layout-slot result 'pure *nil-descriptor*) (cold-set-layout-slot result 'n-untagged-slots nuntagged) + (cold-set-layout-slot result 'for-std-class-p *nil-descriptor*) (setf (gethash name *cold-layouts*) (list result diff --git a/tests/clos.impure.lisp b/tests/clos.impure.lisp index e923afcd7..3fa764a64 100644 --- a/tests/clos.impure.lisp +++ b/tests/clos.impure.lisp @@ -1591,5 +1591,11 @@ (assert (eql 13 (setf (slot-value 123 *magic-symbol*) 13))) (assert (eql 13 (slot-value 'foobar *magic-symbol*))) +;;;; Built-in structure and condition layouts should have NIL in +;;;; LAYOUT-FOR-STD-CLASS-P, and classes should have T. + +(assert (not (sb-pcl::layout-for-std-class-p (sb-pcl::find-layout 'warning)))) +(assert (not (sb-pcl::layout-for-std-class-p (sb-pcl::find-layout 'hash-table)))) +(assert (eq t (sb-pcl::layout-for-std-class-p (sb-pcl::find-layout 'standard-object)))) ;;;; success diff --git a/version.lisp-expr b/version.lisp-expr index 050f6db2d..f6845dd32 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".) -"1.0.9.11" +"1.0.9.12" -- 2.11.4.GIT