0.7.10.28:

        Fixed bug 231: SETQ did not correctly check the type of a
        variable being set (reported by Robert E. Brown)

diff --git a/BUGS b/BUGS
index fcfb26f..4cbbbb8 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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 @@
 \f
 ;;;; 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 (file)
--- 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 (file)
--- 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"