Skip to content

Commit

Permalink
0.7.13.26:
Browse files Browse the repository at this point in the history
        SBCL does not ignore type declarations for special
        variables. (reported by rif on c.l.l 2003-03-05)
  • Loading branch information
Alexey Dejneka committed Mar 13, 2003
1 parent 3586bad commit c5bab4b
Show file tree
Hide file tree
Showing 4 changed files with 40 additions and 18 deletions.
2 changes: 2 additions & 0 deletions NEWS
Expand Up @@ -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
Expand Down
39 changes: 22 additions & 17 deletions src/compiler/ir1tran.lisp
Expand Up @@ -903,34 +903,39 @@
(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
(lexenv-find var-name vars)
(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."
Expand Down
15 changes: 15 additions & 0 deletions tests/compiler.impure.lisp
Expand Up @@ -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

Expand Down
2 changes: 1 addition & 1 deletion version.lisp-expr
Expand Up @@ -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"

0 comments on commit c5bab4b

Please sign in to comment.