ignore non-function FTYPEs

  Fixes lp#738464.

  Give a style-warning and ignore the bad type.

diff --git a/src/compiler/ir1tran.lisp b/src/compiler/ir1tran.lisp
index 984db31..8a4cf1a 100644 (file)
--- 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 (file)
--- 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)))))