From: Andrea Corallo <acorallo@gnu.org>
Date: Wed, 24 Jul 2024 12:08:31 +0000 (+0200)
Subject: Add some basic checking for function type declarations
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=b468b8a1e08a4cfadda9662315b5cb033becaf73;p=emacs.git

Add some basic checking for function type declarations

* lisp/emacs-lisp/byte-run.el (byte-run--anonymize-arg-list): New function.
(byte-run--set-function-type): Add some basic checking for
the function type being declared.

(cherry picked from commit baf9f1210a3e44aa19d9ac90e5a4faca214127a7)
---

diff --git a/lisp/emacs-lisp/byte-run.el b/lisp/emacs-lisp/byte-run.el
index 27033988058..53c62952f96 100644
--- a/lisp/emacs-lisp/byte-run.el
+++ b/lisp/emacs-lisp/byte-run.el
@@ -222,12 +222,27 @@ So far, FUNCTION can only be a symbol, not a lambda expression."
                  (cadr elem)))
               val)))))
 
+(defalias 'byte-run--anonymize-arg-list
+  #'(lambda (arg-list)
+      (mapcar (lambda (x)
+                (if (memq x '(&optional &rest))
+                    x
+                 t))
+              arg-list)))
+
 (defalias 'byte-run--set-function-type
-  #'(lambda (f _args val &optional f2)
+  #'(lambda (f args val &optional f2)
       (when (and f2 (not (eq f2 f)))
         (error
          "`%s' does not match top level function `%s' inside function type \
 declaration" f2 f))
+      (unless (and  (length= val 3)
+                    (eq (car val) 'function)
+                    (listp (car (cdr val))))
+        (error "Type `%s' is not valid a function type" val))
+      (unless (equal (byte-run--anonymize-arg-list args)
+                     (byte-run--anonymize-arg-list (car (cdr val))))
+        (error "Type `%s' incompatible with function arguments `%s'" val args))
       (list 'function-put (list 'quote f)
             ''function-type (list 'quote val))))