1.0.43.39: proclaimed function types and NOTINLINE

 Declaring a function NOTINLINE no longer causes the compiler
 to ignore its proclaimed FTYPE.

 Trusting the proclaimed type is harmless, as NOTINLINE calls
 are compiled just like regular (as opposed to inlined) calls.

diff --git a/NEWS b/NEWS
index 23e34b2..3ee72d0 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -39,6 +39,8 @@ changes relative to sbcl-1.0.43:
   * bug fix: more reliable &REST list type derivation. (lp#655203)
   * bug fix: PPRINT-LOGICAL-BLOCK multiply-evaluated :PER-LINE-PREFIX,
     and issued pointles code-deletion notes for it, :PREFIX, and :SUFFIX.
+  * bug fix: the compiler didn't utilize the proclaimed ftype for functions
+    also declared NOTINLINE. (lp#655581)
 
 changes in sbcl-1.0.43 relative to sbcl-1.0.42:
   * incompatible change: FD-STREAMS no longer participate in the serve-event

diff --git a/src/compiler/ir1tran.lisp b/src/compiler/ir1tran.lisp
index e51dc48..d347bea 100644 (file)
--- a/src/compiler/ir1tran.lisp
+++ b/src/compiler/ir1tran.lisp
@@ -205,14 +205,16 @@
                (inlinep (info :function :inlinep name)))
            (setf (gethash name *free-funs*)
                  (if (or expansion inlinep)
-                     (make-defined-fun
-                      :%source-name name
-                      :inline-expansion expansion
-                      :inlinep inlinep
-                      :where-from (info :function :where-from name)
-                      :type (if (eq inlinep :notinline)
-                                (specifier-type 'function)
-                                (info :function :type name)))
+                     (let ((where (info :function :where-from name)))
+                       (make-defined-fun
+                        :%source-name name
+                        :inline-expansion expansion
+                        :inlinep inlinep
+                        :where-from where
+                        :type (if (and (eq inlinep :notinline)
+                                       (neq where :declared))
+                                  (specifier-type 'function)
+                                  (info :function :type name))))
                      (find-global-fun name nil))))))))
 
 ;;; Return the LEAF structure for the lexically apparent function

diff --git a/tests/compiler.impure.lisp b/tests/compiler.impure.lisp
index a292eb2..2d34a59 100644 (file)
--- a/tests/compiler.impure.lisp
+++ b/tests/compiler.impure.lisp
@@ -1995,4 +1995,15 @@
       (test (double-float 0d0 0d0) 0d0)
       (test (eql #\c) #\c))))
 
+(declaim (ftype (function () (integer 42 42)) bug-655581))
+(defun bug-655581 ()
+  42)
+(declaim (notinline bug-655581))
+(test-util:with-test (:name :bug-655581)
+  (multiple-value-bind (type derived)
+      (funcall (compile nil `(lambda ()
+                               (ctu:compiler-derived-type (bug-655581)))))
+    (assert derived)
+    (assert (equal '(integer 42 42) type))))
+
 ;;; success

diff --git a/version.lisp-expr b/version.lisp-expr
index 330a3b2..6fbe420 100644 (file)
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"1.0.43.38"
+"1.0.43.39"