From b3fc19fd2ee925f1a16e301012094b58c2cfd68a Mon Sep 17 00:00:00 2001 From: Nikodemus Siivola Date: Mon, 6 Oct 2008 09:14:27 +0000 Subject: [PATCH] 1.0.21.6: muffle compiler notes from EVAL and function generator construction * 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 | 2 ++ contrib/sb-cltl2/compiler-let.lisp | 2 +- contrib/sb-cltl2/tests.lisp | 6 ++++-- src/code/eval.lisp | 7 ++++++- src/pcl/fngen.lisp | 4 +++- tests/clos.impure.lisp | 20 ++++++++++++++++++++ tests/eval.impure.lisp | 11 +++++++++++ version.lisp-expr | 2 +- 8 files changed, 48 insertions(+), 6 deletions(-) diff --git a/NEWS b/NEWS index 4c45d3f15..d0619b8bf 100644 --- a/NEWS +++ b/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) diff --git a/contrib/sb-cltl2/compiler-let.lisp b/contrib/sb-cltl2/compiler-let.lisp index 6b82f8dea..e7458dde4 100644 --- a/contrib/sb-cltl2/compiler-let.lisp +++ b/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)))))))) diff --git a/contrib/sb-cltl2/tests.lisp b/contrib/sb-cltl2/tests.lisp index ac775c9c0..137b05599 100644 --- a/contrib/sb-cltl2/tests.lisp +++ b/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) diff --git a/src/code/eval.lisp b/src/code/eval.lisp index 9529f2979..f639dd752 100644 --- a/src/code/eval.lisp +++ b/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))) diff --git a/src/pcl/fngen.lisp b/src/pcl/fngen.lisp index 8488fe5ec..548974a21 100644 --- a/src/pcl/fngen.lisp +++ b/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)))) diff --git a/tests/clos.impure.lisp b/tests/clos.impure.lisp index 3dc1d93c5..d548cffce 100644 --- a/tests/clos.impure.lisp +++ b/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 diff --git a/tests/eval.impure.lisp b/tests/eval.impure.lisp index c5de28bcd..2e6d50299 100644 --- a/tests/eval.impure.lisp +++ b/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 diff --git a/version.lisp-expr b/version.lisp-expr index 3985b8613..34068eb6c 100644 --- 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.21.5" +"1.0.21.6" -- 2.11.4.GIT