1.0.18.11: Add SB-EXT:*MUFFLED-WARNINGS*, to muffle warnings at runtime.

diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr
index 9174aca..3751308 100644 (file)
--- a/package-data-list.lisp-expr
+++ b/package-data-list.lisp-expr
@@ -645,6 +645,9 @@ like *STACK-TOP-HINT* and unsupported stuff like *TRACED-FUN-LIST*."
                ;; and a mechanism for controlling same at compile time
                "MUFFLE-CONDITIONS" "UNMUFFLE-CONDITIONS"
 
+               ;; and one for controlling same at runtime
+               "*MUFFLED-WARNINGS*"
+
                ;; extended declarations..
                "FREEZE-TYPE" "INHIBIT-WARNINGS"
                "MAYBE-INLINE"

diff --git a/src/code/condition.lisp b/src/code/condition.lisp
index 594b3ac..a512b02 100644 (file)
--- a/src/code/condition.lisp
+++ b/src/code/condition.lisp
@@ -1273,7 +1273,11 @@ the values returned by the form as a list. No associated restarts."))
      (format stream "Returning from STEP")))
   #!+sb-doc
   (:documentation "Condition signaled when STEP returns."))
-
+\f
+;;; A knob for muffling warnings, mostly for use while loading files.
+(defvar *muffled-warnings* nil
+  "A type that ought to specify a subtype of WARNING.  Whenever a warning
+is signaled, if the warning if of this type, it will be muffled.")
 \f
 ;;;; restart definitions
 

diff --git a/src/code/target-error.lisp b/src/code/target-error.lisp
index 2f6d3fc..d5025a5 100644 (file)
--- a/src/code/target-error.lisp
+++ b/src/code/target-error.lisp
@@ -19,7 +19,15 @@
 ;;; associated with Condition
 (defvar *condition-restarts* ())
 
-(defvar *handler-clusters* nil)
+(defun initial-handler-clusters ()
+  `(((warning . ,#'(lambda (warning)
+                     (when (typep warning
+                                  (locally
+                                      (declare (special sb!ext:*muffled-warnings*))
+                                    sb!ext:*muffled-warnings*))
+                       (muffle-warning warning)))))))
+
+(defvar *handler-clusters* (initial-handler-clusters))
 
 (defstruct (restart (:copier nil) (:predicate nil))
   (name (missing-arg) :type symbol :read-only t)

diff --git a/src/code/target-thread.lisp b/src/code/target-thread.lisp
index 61ea1af..c37afef 100644 (file)
--- a/src/code/target-thread.lisp
+++ b/src/code/target-thread.lisp
@@ -702,7 +702,7 @@ around and can be retrieved by JOIN-THREAD."
             ;;   --njf, 2006-07-15
             (let* ((*current-thread* thread)
                    (*restart-clusters* nil)
-                   (*handler-clusters* nil)
+                   (*handler-clusters* (sb!kernel::initial-handler-clusters))
                    (*condition-restarts* nil)
                    (sb!impl::*deadline* nil)
                    (sb!impl::*step-out* nil)

diff --git a/version.lisp-expr b/version.lisp-expr
index c4c1bc4..4fb7061 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.18.10"
+"1.0.18.11"