0.7.8.41:

        Proclaimed function type is checked in the XEP.

BUGS

@@ -1268,6 +1268,14 @@ WORKAROUND:
 210: "unsafe evaluation of DEFSTRUCT slot initforms in BOA constructors"
   (fixed in sbcl-0.7.8.35)
 
+211: "keywords processing"
+  a. :ALLOW-OTHER-KEYS T should allow a function to receive an odd
+     number of keyword arguments.
+  b. Compiling of a local call with an unknown key and
+     :ALLOW-OTHER-KEYS T should not cause a WARNING.
+  c. Compiler should not warn on an unknown key :ALLOW-OTHER-KEYS.
+  d. :ALLOW-OTHER-KEYS should be allowed as an ordinary key parameter.
+
 DEFUNCT CATEGORIES OF BUGS
   IR1-#:
     These labels were used for bugs related to the old IR1 interpreter.

src/compiler/ctype.lisp

@@ -672,7 +672,7 @@
 
       (try-type-intersections (vars) (res) where))))
 
-;;; Check that Type doesn't specify any funny args, and do the
+;;; Check that TYPE doesn't specify any funny args, and do the
 ;;; intersection.
 (defun find-lambda-types (lambda type where)
   (declare (type clambda lambda) (type fun-type type) (string where))
@@ -760,6 +760,17 @@
 		     (derive-node-type ref type)))))
 	  t))))))
 
+(defun assert-global-function-definition-type (name fun)
+  (declare (type functional fun))
+  (let ((type (info :function :type name))
+        (where (info :function :where-from name)))
+    (when (eq where :declared)
+      (setf (leaf-type fun) type)
+      (assert-definition-type fun type
+                              :unwinnage-fun #'compiler-note
+                              :where "proclamation"))))
+
+;;;;
 (defun check-catch-tag-type (tag)
   (declare (type continuation tag))
   (let ((ctype (continuation-type tag)))

src/compiler/ir1-translators.lisp

@@ -461,13 +461,15 @@
 ;;; for the function used to implement
 ;;;   (DEFMETHOD PRINT-OBJECT :AROUND ((SS STARSHIP) STREAM) ...).
 (def-ir1-translator named-lambda ((name &rest rest) start cont)
-  (reference-leaf start
-		  cont
-		  (if (legal-fun-name-p name)
-		      (ir1-convert-lambda `(lambda ,@rest)
-					  :source-name name)
-		      (ir1-convert-lambda `(lambda ,@rest)
-					  :debug-name name))))
+  (let* ((fun (if (legal-fun-name-p name)
+                  (ir1-convert-lambda `(lambda ,@rest)
+                                      :source-name name)
+                  (ir1-convert-lambda `(lambda ,@rest)
+                                      :debug-name name)))
+         (leaf (reference-leaf start cont fun)))
+    (when (legal-fun-name-p name)
+      (assert-global-function-definition-type name fun))
+    leaf))
 
 ;;;; FUNCALL
 

src/compiler/main.lisp

@@ -871,13 +871,15 @@
 	  (debug-namify "~S initial component" name))
     (setf (component-kind component) :initial)
     (let* ((locall-fun (ir1-convert-lambda
-			definition
-			:debug-name (debug-namify "top level local call ~S"
-						  name)))
+                        definition
+                        :debug-name (debug-namify "top level local call ~S"
+                                                  name)))
            (fun (ir1-convert-lambda (make-xep-lambda-expression locall-fun)
 				    :source-name (or name '.anonymous.)
 				    :debug-name (unless name
 						  "top level form"))))
+      (when name
+        (assert-global-function-definition-type name locall-fun))
       (setf (functional-entry-fun fun) locall-fun
             (functional-kind fun) :external
             (functional-has-external-references-p fun) t)

tests/list.pure.lisp

@@ -21,11 +21,6 @@
 	 '((:args ((1 2 3 4 5))   :result (1 2 3 4))
 	   (:args ((1 2 3 4 5) 6) :result nil)
 	   (:args (nil)           :result nil)
-	   (:args (t)             :result nil)
-	   (:args (foosymbol 0)   :result foosymbol)
-	   (:args (foosymbol)     :result nil)
-	   (:args (foosymbol 1)   :result nil)
-	   (:args (foosymbol 2)   :result nil)
 	   (:args ((1 2 3) 0)     :result (1 2 3))
 	   (:args ((1 2 3) 1)     :result (1 2))
 	   (:args ((1 2 3))       :result (1 2))
@@ -51,3 +46,12 @@
 	     (actual-result (apply #'nbutlast copied-list rest)))
 	(unless (equal actual-result result)
 	  (error "failed NBUTLAST for ~S" args))))))
+
+(multiple-value-bind (result error)
+    (ignore-errors (apply #'butlast (list t)))
+  (assert (null result))
+  (assert (typep error 'type-error)))
+
+;;; reported by Paul Dietz on cmucl-imp: LDIFF does not check type of
+;;; its first argument
+(assert (not (ignore-errors (ldiff 1 2))))

version.lisp-expr

@@ -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.8.40"
+"0.7.8.41"