From 205a8d17bd0085ab3d6e7d0484cd6a8817118bf5 Mon Sep 17 00:00:00 2001 From: Nikodemus Siivola Date: Tue, 22 Jul 2008 17:17:15 +0000 Subject: [PATCH] 1.0.18.27: fix DEFSTRUCT compilation when init-form type is vague * Reported by Josh Morrison. Regression from the recent DEFSTRUCT constructor hacking. Slots initialized by constructor lambda-list arguments have their types checked, but those slots always initialized directly by the initform values did not -- wrap the DSD-DEFAULT in a THE. --- NEWS | 4 ++++ src/code/defstruct.lisp | 6 +++++- tests/defstruct.impure.lisp | 5 +++++ version.lisp-expr | 2 +- 4 files changed, 15 insertions(+), 2 deletions(-) diff --git a/NEWS b/NEWS index f2a3ae6ca..96e41363b 100644 --- a/NEWS +++ b/NEWS @@ -2,6 +2,10 @@ changes in sbcl-1.0.19 relative to 1.0.18: * optimization: stack allocation is slightly more efficient on x86 and x86-64. + * bug fix: DEFSTRUCT forms with user-specified :CONSTRUCTOR options, + where a raw slot always is initialized using the initform whose + type is not know sufficiently well a compile-time are now compiled + correctly. (reported by John Morrison) * bug fix: compiler no longer makes erronous assumptions in the presense of non-foldable SATISFIES types. * bug fix: stack analysis missed cleanups of dynamic-extent diff --git a/src/code/defstruct.lisp b/src/code/defstruct.lisp index c7575501e..07dd5b471 100644 --- a/src/code/defstruct.lisp +++ b/src/code/defstruct.lisp @@ -1516,10 +1516,14 @@ (loop for slot in (dd-slots defstruct) for name = (dsd-name slot) collect (cond ((find name (skipped-vars) :test #'string=) + ;; CLHS 3.4.6 Boa Lambda Lists (setf (dsd-safe-p slot) nil) '.do-not-initialize-slot.) ((or (find (dsd-name slot) (vars) :test #'string=) - (dsd-default slot))))))))) + (let ((type (dsd-type slot))) + (if (eq t type) + (dsd-default slot) + `(the ,type ,(dsd-default slot)))))))))))) ;;; Grovel the constructor options, and decide what constructors (if ;;; any) to create. diff --git a/tests/defstruct.impure.lisp b/tests/defstruct.impure.lisp index 3549268e1..be0c7e8d8 100644 --- a/tests/defstruct.impure.lisp +++ b/tests/defstruct.impure.lisp @@ -737,3 +737,8 @@ (assert (eql #c(5.0 5.0) (constant-arg-inits-f foo))) (assert (eql #c(6.0d0 6.0d0) (constant-arg-inits-g foo))))) (make-constant-arg-inits) + +;;; bug reported by John Morrison, 2008-07-22 on sbcl-devel +(defstruct (raw-slot-struct-with-unknown-init (:constructor make-raw-slot-struct-with-unknown-init ())) + (x (#:unknown-function) :type double-float)) + diff --git a/version.lisp-expr b/version.lisp-expr index 5debd195b..33ffdb707 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.18.26" +"1.0.18.27" -- 2.11.4.GIT