master: Don't stop compilation on bad type declarations
stassats via Sbcl-commits <[email protected]>
| Newsgroups | gmane.lisp.steel-bank.cvs |
|---|---|
| Message-ID | <[email protected]> |
The branch "master" has been updated in SBCL:
via 4b2be60c8bcb989459328564daed959d5bd3fcfd (commit)
from 09e5b5d14ec199a0e7538a9b18fb88da20200572 (commit)
- Log -----------------------------------------------------------------
commit 4b2be60c8bcb989459328564daed959d5bd3fcfd
Author: Stas Boukarev <[email protected]>
Date: Tue Aug 18 07:35:45 2026 +0300
Don't stop compilation on bad type declarations
---
src/compiler/ir1tran.lisp | 94 ++++++++++++++++++++++++-----------------------
tests/bad-code.pure.lisp | 8 ++++
tests/compiler.pure.lisp | 7 ----
3 files changed, 56 insertions(+), 53 deletions(-)
diff --git a/src/compiler/ir1tran.lisp b/src/compiler/ir1tran.lisp
index 791cc7787..08e97bbde 100644
--- a/src/compiler/ir1tran.lisp
+++ b/src/compiler/ir1tran.lisp
@@ -1265,55 +1265,57 @@
(collect ((restr nil cons)
(new-vars nil cons))
(dolist (var-name (rest decl))
- (unless (symbolp var-name)
- (compiler-error "Variable name is not a symbol: ~S." var-name))
- (unless (eq (info :variable :kind var-name) :unknown)
- (program-assert-symbol-home-package-unlocked
- context var-name "declaring the type of ~A"))
- (let* ((bound-var (find-in-bindings vars var-name))
- (var (or bound-var
- (lexenv-find var-name vars)
- (find-free-var var-name))))
- (maybe-note-undefined-variable-reference var var-name)
- (etypecase var
- (leaf
- (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-intersection old-type type))))
- (cond ((eq int *empty-type*)
- (unless (policy *lexenv* (= inhibit-warnings 3))
- (warn
- 'type-warning
- :format-control
- "The type declarations ~
+ (block skip
+ (unless (symbolp var-name)
+ (compiler-warn "Variable name is not a symbol: ~S." var-name)
+ (return-from skip))
+ (unless (eq (info :variable :kind var-name) :unknown)
+ (program-assert-symbol-home-package-unlocked
+ context var-name "declaring the type of ~A"))
+ (let* ((bound-var (find-in-bindings vars var-name))
+ (var (or bound-var
+ (lexenv-find var-name vars)
+ (find-free-var var-name))))
+ (maybe-note-undefined-variable-reference var var-name)
+ (etypecase var
+ (leaf
+ (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-intersection old-type type))))
+ (cond ((eq int *empty-type*)
+ (unless (policy *lexenv* (= inhibit-warnings 3))
+ (warn
+ 'type-warning
+ :format-control
+ "The type declarations ~
~/sb-impl:print-type/ and ~
~/sb-impl:print-type/ for ~
~S conflict."
- :format-arguments
- (list old-type type var-name))))
- (bound-var
- (setf (leaf-type bound-var) int
- (leaf-where-from bound-var) :declared))
- (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. [See lp#309122]
- (aver (eq (car var) 'macro))
- (new-vars `(,var-name . (macro . (the ,(first decl)
- ,(cdr var))))))
- (heap-alien-info
- (compiler-error
- "~S is an alien variable, so its type can't be declared."
- var-name)))))
+ :format-arguments
+ (list old-type type var-name))))
+ (bound-var
+ (setf (leaf-type bound-var) int
+ (leaf-where-from bound-var) :declared))
+ (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. [See lp#309122]
+ (aver (eq (car var) 'macro))
+ (new-vars `(,var-name . (macro . (the ,(first decl)
+ ,(cdr var))))))
+ (heap-alien-info
+ (compiler-warn
+ "~S is an alien variable, so its type can't be declared."
+ var-name))))))
(if (or (restr) (new-vars))
(make-lexenv :default res
diff --git a/tests/bad-code.pure.lisp b/tests/bad-code.pure.lisp
index 3db776fc5..b75c7563c 100644
--- a/tests/bad-code.pure.lisp
+++ b/tests/bad-code.pure.lisp
@@ -1113,3 +1113,11 @@
`(lambda (m)
(concatenate 'string '(1 #\a) m))
:allow-warnings t))))
+
+(with-test (:name :dont-stop-on-bad-type-declarations)
+ (multiple-value-bind (fun fail warn)
+ (checked-compile
+ `(lambda () (declare (list 1)) 2)
+ :allow-warnings t)
+ (assert (and fail warn))
+ (assert (eql (funcall fun) 2))))
diff --git a/tests/compiler.pure.lisp b/tests/compiler.pure.lisp
index d5bee63c9..d784a0a4e 100644
--- a/tests/compiler.pure.lisp
+++ b/tests/compiler.pure.lisp
@@ -4917,13 +4917,6 @@
(min a -1f0)))
((0f0 1) -1f0)))
-(with-test (:name :malformed-declare)
- (assert (nth-value
- 1 (checked-compile `(lambda (x)
- (declare (unsigned-byte (x)))
- x)
- :allow-failure t))))
-
(with-test (:name :no-dubious-asterisk-warning)
(checked-compile
`(lambda (foo)
-----------------------------------------------------------------------
hooks/post-receive
--
SBCL