From d2cbbce99d82ad691626e6371085e5b20e7cb6c2 Mon Sep 17 00:00:00 2001 From: William Harold Newman Date: Sun, 13 Oct 2002 19:59:43 +0000 Subject: [PATCH] 0.7.8.35: fixed a code-safety bug in BOA constructors --- BUGS | 3 +++ src/code/defstruct.lisp | 1 - tests/defstruct.impure.lisp | 15 +++++++++++++++ version.lisp-expr | 12 ++++++------ 4 files changed, 24 insertions(+), 7 deletions(-) diff --git a/BUGS b/BUGS index 7942a1f..a2953f9 100644 --- a/BUGS +++ b/BUGS @@ -1272,6 +1272,9 @@ WORKAROUND: correct generic function definition in the PCL source code, SBCL returns "WRONG!" for the call. +210: "unsafe evaluation of DEFSTRUCT slot initforms in BOA constructors" + (fixed in sbcl-0.7.8.35) + DEFUNCT CATEGORIES OF BUGS IR1-#: These labels were used for bugs related to the old IR1 interpreter. diff --git a/src/code/defstruct.lisp b/src/code/defstruct.lisp index 984fa3a..a894f47 100644 --- a/src/code/defstruct.lisp +++ b/src/code/defstruct.lisp @@ -1176,7 +1176,6 @@ (let ((,instance (truly-the ,(dd-name dd) (%make-instance-with-layout (%delayed-get-compiler-layout ,(dd-name dd)))))) - (declare (optimize (safety 0))) ; Suppress redundant slot type checks. ,@(when raw-index `((setf (%instance-ref ,instance ,raw-index) (make-array ,(dd-raw-length dd) diff --git a/tests/defstruct.impure.lisp b/tests/defstruct.impure.lisp index bca97ca..9cdc9d0 100644 --- a/tests/defstruct.impure.lisp +++ b/tests/defstruct.impure.lisp @@ -360,6 +360,21 @@ (error "YA-STRUCT-P of no arguments should signal an error.")) (when (ignore-errors (or (ya-struct-p 'too 'many 'arguments) 12)) (error "YA-STRUCT-P of three arguments should signal an error.")) + +;;; bug 210: Until sbcl-0.7.8.32 BOA constructors had SAFETY 0 +;;; declared inside on the theory that slot types were already +;;; checked, which bogusly suppressed unbound-variable and other +;;; checks within the evaluation of initforms. +(defvar *bug210*) +(defstruct (bug210a (:constructor bug210a ())) + (slot *bug210*)) +(defstruct bug210b + (slot *bug210*)) +;;; Because of bug 210, this assertion used to fail. +(assert (typep (nth-value 1 (ignore-errors (bug210a))) 'unbound-variable)) +;;; Even with bug 210, these assertions succeeded. +(assert (typep (nth-value 1 (ignore-errors *bug210*)) 'unbound-variable)) +(assert (typep (nth-value 1 (ignore-errors (make-bug210b))) 'unbound-variable)) ;;; success (format t "~&/returning success~%") diff --git a/version.lisp-expr b/version.lisp-expr index 6a76f1c..0ec4ea7 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -12,10 +12,10 @@ ;;; relevant result, so this must be a string, not NIL. ;;; ;;; Conventionally a string like "0.6.6", with three numeric fields, -;;; is used for released versions, and a string like "0.6.5.12", with -;;; four numeric fields, is used for CVS 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".) +;;; is used for released versions, and a string like "0.6.5.xyzzy", +;;; with something arbitrary in the fourth field, is used for CVS +;;; 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.7.8.34" +"0.7.8.35" -- 1.7.10.4