From 71985ecfdc880e6c11a191d799313de9b4e0c12b Mon Sep 17 00:00:00 2001 From: Alexey Dejneka Date: Sat, 21 Dec 2002 06:38:00 +0000 Subject: [PATCH] 0.7.10.28: Fixed bug 231: SETQ did not correctly check the type of a variable being set (reported by Robert E. Brown) --- BUGS | 18 ++++++++++-------- NEWS | 2 ++ src/compiler/ir1-translators.lisp | 4 ++-- tests/compiler-1.impure-cload.lisp | 20 +++++++++++++++++++- version.lisp-expr | 2 +- 5 files changed, 34 insertions(+), 12 deletions(-) diff --git a/BUGS b/BUGS index fcfb26f..4cbbbb8 100644 --- a/BUGS +++ b/BUGS @@ -1190,20 +1190,22 @@ WORKAROUND: 229: (subtypep 'function '(function)) => nil, t. -231: "extra binding causes type declaration semantics to be lost" +231: "SETQ does not correctly check the type of a variable being set" (reported by Robert E. Brown sbcl-devel 2002-12-19) - in sbcl-0.7.10.19, + in sbcl-0.7.10.19, (DEFUN FOO (X) (DECLARE (OPTIMIZE SAFETY) (TYPE (INTEGER 0 8) X)) (INCF X)) (FOO 8) returns 9, rather than (as in CMUCL) signalling an error. Replacing - (INCF X) by (SETQ X (+ X 1)) causes a TYPE-ERROR to be signalled - [the difference between the two being that (INCF X) looks like - (LET ((#:G1 (+ X 1))) - (SETQ X #:G1)) - so suspicion falls on the binding obscuring the type declaration - somehow] + (INCF X) by (SETQ X (+ X 1)) causes a TYPE-ERROR to be signalled. Or + (defun bar (x y) + (declare (type (integer 0 8) x)) + (setq x y) + x) + Then (BAR 7 9) returns 9. + + (fixed in 0.7.10.28) DEFUNCT CATEGORIES OF BUGS IR1-#: diff --git a/NEWS b/NEWS index 5a93a5d..02200a7 100644 --- a/NEWS +++ b/NEWS @@ -1473,6 +1473,8 @@ changes in sbcl-0.7.11 relative to sbcl-0.7.10: of the new implementation of DEFINE-COMPILER-MACRO. * fixed bug 223: functional binding is considered to be constant only for symbols in the CL package. + * fixed bug 231: SETQ did not check the type of a variable being set + (reported by Robert E. Brown) planned incompatible changes in 0.7.x: * (not done yet, but planned:) When the profiling interface settles diff --git a/src/compiler/ir1-translators.lisp b/src/compiler/ir1-translators.lisp index 398e692..8eb3b48 100644 --- a/src/compiler/ir1-translators.lisp +++ b/src/compiler/ir1-translators.lisp @@ -848,8 +848,8 @@ (defun setq-var (start cont var value) (declare (type continuation start cont) (type basic-var var)) (let ((dest (make-continuation))) - (assert-continuation-type dest (leaf-type var) (lexenv-policy *lexenv*)) (ir1-convert start dest value) + (assert-continuation-type dest (leaf-type var) (lexenv-policy *lexenv*)) (let ((res (make-set :var var :value dest))) (setf (continuation-dest dest) res) (setf (leaf-ever-used var) t) @@ -859,7 +859,7 @@ ;;;; CATCH, THROW and UNWIND-PROTECT -;;; We turn THROW into a multiple-value-call of a magical function, +;;; We turn THROW into a MULTIPLE-VALUE-CALL of a magical function, ;;; since as as far as IR1 is concerned, it has no interesting ;;; properties other than receiving multiple-values. (def-ir1-translator throw ((tag result) start cont) diff --git a/tests/compiler-1.impure-cload.lisp b/tests/compiler-1.impure-cload.lisp index cdad366..8bc82bf 100644 --- a/tests/compiler-1.impure-cload.lisp +++ b/tests/compiler-1.impure-cload.lisp @@ -14,6 +14,9 @@ (cl:in-package :cl-user) +(load "assertoid") +(use-package "ASSERTOID") + (declaim (optimize (debug 3) (speed 2) (space 1))) ;;; Until version 0.6.9 or so, SBCL's version of Python couldn't do @@ -172,5 +175,20 @@ (t (safe-format t "~&baz ~S (~A) ~S" condition condition result))))))) -(sb-ext:quit :unix-status 104) ; success +;;; bug 231: SETQ did not check the type of the variable being set +(defun bug231-1 (x) + (declare (optimize safety) (type (integer 0 8) x)) + (incf x)) +(assert (raises-error? (bug231-1 8) type-error)) + +(defun bug231-2 (x) + (declare (optimize safety) (type (integer 0 8) x)) + (list (lambda (y) (setq x y)) + (lambda () x))) +(destructuring-bind (set get) (bug231-2 0) + (funcall set 8) + (assert (eql (funcall get) 8)) + (assert (raises-error? (funcall set 9) type-error)) + (assert (eql (funcall get) 8))) +(sb-ext:quit :unix-status 104) ; success diff --git a/version.lisp-expr b/version.lisp-expr index 37e7691..b53fc05 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -18,4 +18,4 @@ ;;; versions, especially for internal versions off the main CVS ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"0.7.10.27" +"0.7.10.28" -- 1.7.10.4