0.7.13.26:

        SBCL does not ignore type declarations for special
        variables. (reported by rif on c.l.l 2003-03-05)

diff --git a/NEWS b/NEWS
index 7aae843..dfb3d64 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -1603,6 +1603,8 @@ changes in sbcl-0.7.14 relative to sbcl-0.7.13:
     declarations (SYMBOL or LIST). (thanks to Gerd Moellmann)
   * fixed bug in DEFPARAMETER and DEFVAR: they could assign a lexical
     variable. (found by Rolf Wester)
+  * SBCL does not ignore type declarations for special
+    variables. (reported by rif on c.l.l 2003-03-05)
 
 planned incompatible changes in 0.7.x:
   * (not done yet, but planned:) When the profiling interface settles

diff --git a/src/compiler/ir1tran.lisp b/src/compiler/ir1tran.lisp
index 38866b9..3a3376a 100644 (file)
--- a/src/compiler/ir1tran.lisp
+++ b/src/compiler/ir1tran.lisp
@@ -903,7 +903,7 @@
   (declare (list decl vars) (type lexenv res))
   (let ((type (compiler-specifier-type (first decl))))
     (collect ((restr nil cons)
-             (new-vars nil cons))
+             (new-vars nil cons))
       (dolist (var-name (rest decl))
        (let* ((bound-var (find-in-bindings vars var-name))
               (var (or bound-var
@@ -911,26 +911,31 @@
                        (find-free-var var-name))))
          (etypecase var
            (leaf
-            (let* ((old-type (or (lexenv-find var type-restrictions)
-                                 (leaf-type var)))
-                   (int (if (or (fun-type-p type)
-                                (fun-type-p old-type))
-                            type
-                            (type-approx-intersection2 old-type type))))
-              (cond ((eq int *empty-type*)
-                     (unless (policy *lexenv* (= inhibit-warnings 3))
-                       (compiler-warn
-                        "The type declarations ~S and ~S for ~S conflict."
-                        (type-specifier old-type) (type-specifier type)
-                        var-name)))
-                    (bound-var (setf (leaf-type bound-var) int))
-                    (t
-                     (restr (cons var int))))))
+             (flet ((process-var (var bound-var)
+                      (let* ((old-type (or (lexenv-find var type-restrictions)
+                                           (leaf-type var)))
+                             (int (if (or (fun-type-p type)
+                                          (fun-type-p old-type))
+                                      type
+                                      (type-approx-intersection2 old-type type))))
+                        (cond ((eq int *empty-type*)
+                               (unless (policy *lexenv* (= inhibit-warnings 3))
+                                 (compiler-warn
+                                  "The type declarations ~S and ~S for ~S conflict."
+                                  (type-specifier old-type) (type-specifier type)
+                                  var-name)))
+                              (bound-var (setf (leaf-type bound-var) int))
+                              (t
+                               (restr (cons var int)))))))
+               (process-var var bound-var)
+               (awhen (and (lambda-var-p var)
+                           (lambda-var-specvar var))
+                      (process-var it nil))))
            (cons
             ;; FIXME: non-ANSI weirdness
             (aver (eq (car var) 'MACRO))
             (new-vars `(,var-name . (MACRO . (the ,(first decl)
-                                                  ,(cdr var))))))
+                                                ,(cdr var))))))
            (heap-alien-info
             (compiler-error
              "~S is an alien variable, so its type can't be declared."

diff --git a/tests/compiler.impure.lisp b/tests/compiler.impure.lisp
index 9a2aed6..d904439 100644 (file)
--- a/tests/compiler.impure.lisp
+++ b/tests/compiler.impure.lisp
@@ -763,6 +763,21 @@ BUG 48c, not yet fixed:
   (when x
     (assert (= (funcall (compile nil x) 1) 2))))
 
+;;; Bug reported by reported by rif on c.l.l 2003-03-05
+(defun test-type-of-special-1 (x)
+  (declare (special x)
+           (fixnum x)
+           (optimize (safety 3)))
+  (list x))
+(defun test-type-of-special-2 (x)
+  (declare (special x)
+           (fixnum x)
+           (optimize (safety 3)))
+  (list x (setq x (/ x 2)) x))
+(assert (raises-error? (test-type-of-special-1 3/2) type-error))
+(assert (raises-error? (test-type-of-special-2 3) type-error))
+(assert (equal (test-type-of-special-2 8) '(8 4 4)))
+
 ;;;; tests not in the problem domain, but of the consistency of the
 ;;;; compiler machinery itself
 

diff --git a/version.lisp-expr b/version.lisp-expr
index b9dcdab..fd749ab 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.13.25"
+"0.7.13.26"