From aa29ec0354034ea928f56bbedef1edd158a42c79 Mon Sep 17 00:00:00 2001 From: Nikodemus Siivola Date: Wed, 17 Aug 2011 12:28:29 +0300 Subject: [PATCH] ignore non-function FTYPEs Fixes lp#738464. Give a style-warning and ignore the bad type. --- src/compiler/ir1tran.lisp | 3 +++ tests/compiler.pure.lisp | 9 +++++++++ 2 files changed, 12 insertions(+) diff --git a/src/compiler/ir1tran.lisp b/src/compiler/ir1tran.lisp index 984db31..8a4cf1a 100644 --- a/src/compiler/ir1tran.lisp +++ b/src/compiler/ir1tran.lisp @@ -1205,6 +1205,9 @@ (declare (type list names fvars) (type lexenv res)) (let ((type (compiler-specifier-type spec))) + (unless (csubtypep type (specifier-type 'function)) + (compiler-style-warn "ignoring declared FTYPE: ~S (not a function type)" spec) + (return-from process-ftype-decl res)) (collect ((res nil cons)) (dolist (name names) (when (fboundp name) diff --git a/tests/compiler.pure.lisp b/tests/compiler.pure.lisp index fa8da25..fff0ec4 100644 --- a/tests/compiler.pure.lisp +++ b/tests/compiler.pure.lisp @@ -3985,3 +3985,12 @@ (fun (compile nil `(lambda (p1 p2) (schar (the (eql ,foo) p1) p2))))) (assert (eql #\f (funcall fun foo 0))))) + +(with-test (:name :bug-738464) + (multiple-value-bind (fun warn fail) + (compile nil `(lambda () + (flet ((foo () 42)) + (declare (ftype non-function-type foo)) + (foo)))) + (assert (eql 42 (funcall fun))) + (assert (and warn (not fail))))) -- 1.7.10.4