From c5bab4bfbaa001cae1fb08437c149ba7c711f67a Mon Sep 17 00:00:00 2001 From: Alexey Dejneka Date: Thu, 13 Mar 2003 10:38:07 +0000 Subject: [PATCH] 0.7.13.26: SBCL does not ignore type declarations for special variables. (reported by rif on c.l.l 2003-03-05) --- NEWS | 2 ++ src/compiler/ir1tran.lisp | 39 ++++++++++++++++++++++----------------- tests/compiler.impure.lisp | 15 +++++++++++++++ version.lisp-expr | 2 +- 4 files changed, 40 insertions(+), 18 deletions(-) diff --git a/NEWS b/NEWS index 7aae843..dfb3d64 100644 --- 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 --- 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 --- 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 --- 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" -- 1.7.10.4