1.0.29.49: silence compiler note for type-checks from MAKE-INSTANCE in safe code

* Reported by Samium Gromoff.

diff --git a/NEWS b/NEWS
index c1d2e37..19ebe75 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -61,6 +61,8 @@
   * bug fix: SLEEP accepts large integer arguments, truncating them to
     SIGNED-WORD on the assumption that sleeping for 68 years is sufficient
     for anyone. (reported by Leslie Polzer, thanks to Stas Boukarev)
+  * bug fix: compiler notes for expensive slot type checks could be emitted
+    at runtime MAKE-INSTANCE calls. (reported by Samium Gromoff)
 
 changes in sbcl-1.0.29 relative to 1.0.28:
   * IMPORTANT: bug database has moved from the BUGS file to Launchpad

diff --git a/src/pcl/ctor.lisp b/src/pcl/ctor.lisp
index 6a81d8c..403732a 100644 (file)
--- a/src/pcl/ctor.lisp
+++ b/src/pcl/ctor.lisp
@@ -446,7 +446,8 @@
                 (constructor-function-form ctor)
               (apply
                (let ((*compiling-optimized-constructor* t))
-                 (compile nil `(lambda ,names ,form)))
+                 (handler-bind ((compiler-note #'muffle-warning))
+                   (compile nil `(lambda ,names ,form))))
                locations))))))
 
 (defun constructor-function-form (ctor)

diff --git a/tests/ctor.impure.lisp b/tests/ctor.impure.lisp
index 0fda4eb..69daa7a 100644 (file)
--- a/tests/ctor.impure.lisp
+++ b/tests/ctor.impure.lisp
@@ -186,5 +186,17 @@
     ;; make sure we tested what we think we tested...
     (let ((ctor (find-callee fun :type 'sb-pcl::ctor)))
       (assert (find-callee ctor :name 'sb-pcl::fast-make-instance)))))
+
+;;; No compiler notes, please
+(locally (declare (optimize safety))
+  (defclass type-check-thing ()
+    ((slot :type (integer 0) :initarg :slot))))
+(with-test (:name (make-instance :no-compile-note-at-runtime))
+  (let ((fun (compile nil `(lambda (x)
+                             (declare (optimize safety))
+                             (make-instance 'type-check-thing :slot x)))))
+    (handler-bind ((sb-ext:compiler-note #'error))
+      (funcall fun 41)
+      (funcall fun 13))))
 \f
 ;;;; success

diff --git a/version.lisp-expr b/version.lisp-expr
index 2d13684..cec7e24 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.29.48"
+"1.0.29.49"