1.0.21.6: muffle compiler notes from EVAL and function generator cons…

…truction

 * Just add (DECLARE (MUFFLE-CONDITIONS COMPILER-NOTE)) to the lambdas
   we cons up: in case of EVAL the notes are distractive and seem
   pointless, and in case of generators the user is definitely not
   interested.

 * Adjust SB-CLTL2 tests slightly to account for possible pre-existing
   MUFFLE-CONDITIONS declarations, and fix usage of SPECIAL-BINDINGS.

NEWS

@@ -1,5 +1,7 @@
 ;;;; -*- coding: utf-8; -*-
 changes in sbcl-1.0.22 relative to 1.0.21:
+  * enhancement: inoccous calls to EVAL or generic functions dispatching
+    on subclasses of eg. STREAM no longer cause compiler notes to appear.
   * bug fix: ADJUST-ARRAY on multidimensional arrays used bogusly give
     them a fill pointer unless :DISPLACED-TO or :INITIAL-CONTENTS were
     provided. (reported by Cedric St-Jean)

contrib/sb-cltl2/compiler-let.lisp

@@ -44,6 +44,6 @@
                 finally (return
                           (let ((new-env (sb-eval::make-env
                                           :parent env
-                                          :vars (sb-eval::special-bindings vars))))
+                                          :vars (sb-eval::special-bindings vars env))))
                             (progv vars values
                               (sb-eval::eval-progn body new-env))))))))

contrib/sb-cltl2/tests.lisp

@@ -98,12 +98,14 @@
     (dinfo sb-ext:muffle-conditions))
   warning)
 (deftest declaration-information.muffle-conditions.2
-  (locally (declare (sb-ext:muffle-conditions warning))
+  (let ((junk (dinfo sb-ext:muffle-conditions)))
+    (declare (sb-ext:muffle-conditions warning))
     (locally (declare (sb-ext:unmuffle-conditions style-warning))
       (let ((dinfo (dinfo sb-ext:muffle-conditions)))
         (not
          (not
-          (and (subtypep dinfo '(and warning (not style-warning)))
+          (and (subtypep dinfo `(or (and warning (not style-warning))
+                                    (and ,junk (not style-warning))))
                (subtypep '(and warning (not style-warning)) dinfo)))))))
   t)
 

src/code/eval.lisp

@@ -29,9 +29,14 @@
   ;; to be careful about not muffling warnings arising from inner
   ;; evaluations/compilations, though [e.g. the ignored variable in
   ;; (DEFUN FOO (X) 1)].  -- CSR, 2003-05-13
+  ;;
+  ;; As of 1.0.21.6 we muffle compiler notes lexically here, which seems
+  ;; always safe. --NS
   (let* (;; why PROGN?  So that attempts to eval free declarations
          ;; signal errors rather than return NIL.  -- CSR, 2007-05-01
-         (lambda `(lambda () (progn ,expr)))
+         (lambda `(lambda ()
+                    (declare (muffle-conditions compiler-note))
+                    (progn ,expr)))
          (fun (sb!c:compile-in-lexenv nil lambda lexenv)))
     (funcall fun)))
 

src/pcl/fngen.lisp

@@ -111,7 +111,9 @@
 
 (defun get-new-fun-generator (lambda test code-converter)
   (multiple-value-bind (code gensyms) (compute-code lambda code-converter)
-    (let ((generator-lambda `(lambda ,gensyms (function ,code))))
+    (let ((generator-lambda `(lambda ,gensyms
+                               (declare (muffle-conditions compiler-note))
+                               (function ,code))))
       (let ((generator (compile nil generator-lambda)))
         (ensure-fgen test gensyms generator generator-lambda nil)
         generator))))

tests/clos.impure.lisp

@@ -1619,5 +1619,25 @@
 (handler-bind ((warning #'error))
   (assert (= 123 (slot-value (provoke-ctor-default-initarg-problem) 'slot))))
 
+;;;; discriminating net on streams used to generate code deletion notes on
+;;;; first call
+(defgeneric stream-fd (stream direction))
+(defmethod stream-fd ((stream sb-sys:fd-stream) direction)
+  (declare (ignore direction))
+  (sb-sys:fd-stream-fd stream))
+(defmethod stream-fd ((stream synonym-stream) direction)
+  (stream-fd (symbol-value (synonym-stream-symbol stream)) direction))
+(defmethod stream-fd ((stream two-way-stream) direction)
+  (ecase direction
+    (:input
+     (stream-fd
+      (two-way-stream-input-stream stream) direction))
+    (:output
+     (stream-fd
+      (two-way-stream-output-stream stream) direction))))
+(with-test (:name (:discriminating-name :code-deletion-note))
+  (handler-bind ((compiler-note #'error))
+    (stream-fd sb-sys:*stdin* :output)
+    (stream-fd sb-sys:*stdin* :output)))
 
 ;;;; success

tests/eval.impure.lisp

@@ -226,4 +226,15 @@
 (with-test (:name :toplevel-declare)
   (assert (raises-error? (eval '(declare (type pathname *scratch*))))))
 
+(with-test (:name (eval no-compiler-notes))
+  (handler-bind ((sb-ext:compiler-note #'error))
+    (let ((sb-ext:*evaluator-mode* :compile))
+      (eval '(let ((x 42))
+              (if nil x)))
+      (eval '(let ((* 13))
+              (let ((x 42)
+                    (y *))
+                (declare (optimize speed))
+                (+ x y)))))))
+
 ;;; success

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.21.5"
+"1.0.21.6"