Common Lisp: Suppress messages from CMUCL while restoring image

The 'Reloaded library ... ' messages were causing some tests to fail

diff --git a/common-lisp/step0_repl.lisp b/common-lisp/step0_repl.lisp
index dc5814a..4f43b58 100644 (file)
--- a/common-lisp/step0_repl.lisp
+++ b/common-lisp/step0_repl.lisp
@@ -56,3 +56,21 @@
 
   (loop do (let ((line (mal-readline "user> ")))
              (if line (mal-writeline (rep line)) (return)))))
+
+;;; Workaround for CMUCL's printing of "Reloaded library ... " messages when an
+;;; image containing foreign libraries is restored. The extra messages cause the
+;;; MAL testcases to fail
+
+#+cmucl (progn
+          (defvar *old-standard-output* *standard-output*
+            "Keep track of current value standard output, this is restored after image restore completes")
+
+          (defun muffle-output ()
+            (setf *standard-output* (make-broadcast-stream)))
+
+          (defun restore-output ()
+            (setf *standard-output* *old-standard-output*))
+
+          (pushnew #'muffle-output ext:*after-save-initializations*)
+          (setf ext:*after-save-initializations*
+                (append ext:*after-save-initializations* (list #'restore-output))))

diff --git a/common-lisp/step1_read_print.lisp b/common-lisp/step1_read_print.lisp
index e72aa29..f0032b6 100644 (file)
--- a/common-lisp/step1_read_print.lisp
+++ b/common-lisp/step1_read_print.lisp
@@ -64,3 +64,21 @@
 
   (loop do (let ((line (mal-readline "user> ")))
              (if line (mal-writeline (rep line)) (return)))))
+
+;;; Workaround for CMUCL's printing of "Reloaded library ... " messages when an
+;;; image containing foreign libraries is restored. The extra messages cause the
+;;; MAL testcases to fail
+
+#+cmucl (progn
+          (defvar *old-standard-output* *standard-output*
+            "Keep track of current value standard output, this is restored after image restore completes")
+
+          (defun muffle-output ()
+            (setf *standard-output* (make-broadcast-stream)))
+
+          (defun restore-output ()
+            (setf *standard-output* *old-standard-output*))
+
+          (pushnew #'muffle-output ext:*after-save-initializations*)
+          (setf ext:*after-save-initializations*
+                (append ext:*after-save-initializations* (list #'restore-output))))

diff --git a/common-lisp/step2_eval.lisp b/common-lisp/step2_eval.lisp
index c360a85..b19c5fd 100644 (file)
--- a/common-lisp/step2_eval.lisp
+++ b/common-lisp/step2_eval.lisp
@@ -127,3 +127,21 @@
 
   (loop do (let ((line (mal-readline "user> ")))
              (if line (mal-writeline (rep line)) (return)))))
+
+;;; Workaround for CMUCL's printing of "Reloaded library ... " messages when an
+;;; image containing foreign libraries is restored. The extra messages cause the
+;;; MAL testcases to fail
+
+#+cmucl (progn
+          (defvar *old-standard-output* *standard-output*
+            "Keep track of current value standard output, this is restored after image restore completes")
+
+          (defun muffle-output ()
+            (setf *standard-output* (make-broadcast-stream)))
+
+          (defun restore-output ()
+            (setf *standard-output* *old-standard-output*))
+
+          (pushnew #'muffle-output ext:*after-save-initializations*)
+          (setf ext:*after-save-initializations*
+                (append ext:*after-save-initializations* (list #'restore-output))))

diff --git a/common-lisp/step3_env.lisp b/common-lisp/step3_env.lisp
index bdb3422..7bb2057 100644 (file)
--- a/common-lisp/step3_env.lisp
+++ b/common-lisp/step3_env.lisp
@@ -156,3 +156,21 @@
 
   (loop do (let ((line (mal-readline "user> ")))
              (if line (mal-writeline (rep line)) (return)))))
+
+;;; Workaround for CMUCL's printing of "Reloaded library ... " messages when an
+;;; image containing foreign libraries is restored. The extra messages cause the
+;;; MAL testcases to fail
+
+#+cmucl (progn
+          (defvar *old-standard-output* *standard-output*
+            "Keep track of current value standard output, this is restored after image restore completes")
+
+          (defun muffle-output ()
+            (setf *standard-output* (make-broadcast-stream)))
+
+          (defun restore-output ()
+            (setf *standard-output* *old-standard-output*))
+
+          (pushnew #'muffle-output ext:*after-save-initializations*)
+          (setf ext:*after-save-initializations*
+                (append ext:*after-save-initializations* (list #'restore-output))))

diff --git a/common-lisp/step4_if_fn_do.lisp b/common-lisp/step4_if_fn_do.lisp
index 7ee011b..1f7bfa3 100644 (file)
--- a/common-lisp/step4_if_fn_do.lisp
+++ b/common-lisp/step4_if_fn_do.lisp
@@ -159,3 +159,21 @@
 
   (loop do (let ((line (mal-readline "user> ")))
              (if line (mal-writeline (rep line)) (return)))))
+
+;;; Workaround for CMUCL's printing of "Reloaded library ... " messages when an
+;;; image containing foreign libraries is restored. The extra messages cause the
+;;; MAL testcases to fail
+
+#+cmucl (progn
+          (defvar *old-standard-output* *standard-output*
+            "Keep track of current value standard output, this is restored after image restore completes")
+
+          (defun muffle-output ()
+            (setf *standard-output* (make-broadcast-stream)))
+
+          (defun restore-output ()
+            (setf *standard-output* *old-standard-output*))
+
+          (pushnew #'muffle-output ext:*after-save-initializations*)
+          (setf ext:*after-save-initializations*
+                (append ext:*after-save-initializations* (list #'restore-output))))

diff --git a/common-lisp/step5_tco.lisp b/common-lisp/step5_tco.lisp
index 7dae7ba..aa6244f 100644 (file)
--- a/common-lisp/step5_tco.lisp
+++ b/common-lisp/step5_tco.lisp
@@ -170,3 +170,21 @@
 
   (loop do (let ((line (mal-readline "user> ")))
              (if line (mal-writeline (rep line)) (return)))))
+
+;;; Workaround for CMUCL's printing of "Reloaded library ... " messages when an
+;;; image containing foreign libraries is restored. The extra messages cause the
+;;; MAL testcases to fail
+
+#+cmucl (progn
+          (defvar *old-standard-output* *standard-output*
+            "Keep track of current value standard output, this is restored after image restore completes")
+
+          (defun muffle-output ()
+            (setf *standard-output* (make-broadcast-stream)))
+
+          (defun restore-output ()
+            (setf *standard-output* *old-standard-output*))
+
+          (pushnew #'muffle-output ext:*after-save-initializations*)
+          (setf ext:*after-save-initializations*
+                (append ext:*after-save-initializations* (list #'restore-output))))

diff --git a/common-lisp/step6_file.lisp b/common-lisp/step6_file.lisp
index 157dd5a..71a4f79 100644 (file)
--- a/common-lisp/step6_file.lisp
+++ b/common-lisp/step6_file.lisp
@@ -192,3 +192,21 @@
     (if (null args)
         (repl)
         (run-file (car args)))))
+
+;;; Workaround for CMUCL's printing of "Reloaded library ... " messages when an
+;;; image containing foreign libraries is restored. The extra messages cause the
+;;; MAL testcases to fail
+
+#+cmucl (progn
+          (defvar *old-standard-output* *standard-output*
+            "Keep track of current value standard output, this is restored after image restore completes")
+
+          (defun muffle-output ()
+            (setf *standard-output* (make-broadcast-stream)))
+
+          (defun restore-output ()
+            (setf *standard-output* *old-standard-output*))
+
+          (pushnew #'muffle-output ext:*after-save-initializations*)
+          (setf ext:*after-save-initializations*
+                (append ext:*after-save-initializations* (list #'restore-output))))

diff --git a/common-lisp/step7_quote.lisp b/common-lisp/step7_quote.lisp
index fdac605..3250f80 100644 (file)
--- a/common-lisp/step7_quote.lisp
+++ b/common-lisp/step7_quote.lisp
@@ -228,3 +228,21 @@
     (if (null args)
         (repl)
         (run-file (car args)))))
+
+;;; Workaround for CMUCL's printing of "Reloaded library ... " messages when an
+;;; image containing foreign libraries is restored. The extra messages cause the
+;;; MAL testcases to fail
+
+#+cmucl (progn
+          (defvar *old-standard-output* *standard-output*
+            "Keep track of current value standard output, this is restored after image restore completes")
+
+          (defun muffle-output ()
+            (setf *standard-output* (make-broadcast-stream)))
+
+          (defun restore-output ()
+            (setf *standard-output* *old-standard-output*))
+
+          (pushnew #'muffle-output ext:*after-save-initializations*)
+          (setf ext:*after-save-initializations*
+                (append ext:*after-save-initializations* (list #'restore-output))))

diff --git a/common-lisp/step8_macros.lisp b/common-lisp/step8_macros.lisp
index cd37637..a8f370b 100644 (file)
--- a/common-lisp/step8_macros.lisp
+++ b/common-lisp/step8_macros.lisp
@@ -287,3 +287,21 @@
     (if (null args)
         (repl)
         (run-file (car args)))))
+
+;;; Workaround for CMUCL's printing of "Reloaded library ... " messages when an
+;;; image containing foreign libraries is restored. The extra messages cause the
+;;; MAL testcases to fail
+
+#+cmucl (progn
+          (defvar *old-standard-output* *standard-output*
+            "Keep track of current value standard output, this is restored after image restore completes")
+
+          (defun muffle-output ()
+            (setf *standard-output* (make-broadcast-stream)))
+
+          (defun restore-output ()
+            (setf *standard-output* *old-standard-output*))
+
+          (pushnew #'muffle-output ext:*after-save-initializations*)
+          (setf ext:*after-save-initializations*
+                (append ext:*after-save-initializations* (list #'restore-output))))

diff --git a/common-lisp/step9_try.lisp b/common-lisp/step9_try.lisp
index cb3c584..cbf759c 100644 (file)
--- a/common-lisp/step9_try.lisp
+++ b/common-lisp/step9_try.lisp
@@ -315,3 +315,21 @@
     (if (null args)
         (repl)
         (run-file (car args)))))
+
+;;; Workaround for CMUCL's printing of "Reloaded library ... " messages when an
+;;; image containing foreign libraries is restored. The extra messages cause the
+;;; MAL testcases to fail.
+
+#+cmucl (progn
+          (defvar *old-standard-output* *standard-output*
+            "Keep track of current value standard output, this is restored after image restore completes")
+
+          (defun muffle-output ()
+            (setf *standard-output* (make-broadcast-stream)))
+
+          (defun restore-output ()
+            (setf *standard-output* *old-standard-output*))
+
+          (pushnew #'muffle-output ext:*after-save-initializations*)
+          (setf ext:*after-save-initializations*
+                (append ext:*after-save-initializations* (list #'restore-output))))

diff --git a/common-lisp/stepA_mal.lisp b/common-lisp/stepA_mal.lisp
index ec42b99..84b7690 100644 (file)
--- a/common-lisp/stepA_mal.lisp
+++ b/common-lisp/stepA_mal.lisp
@@ -327,3 +327,21 @@
     (if (null args)
         (repl)
         (run-file (car args)))))
+
+;;; Workaround for CMUCL's printing of "Reloaded library ... " messages when an
+;;; image containing foreign libraries is restored. The extra messages cause the
+;;; MAL testcases to fail
+
+#+cmucl (progn
+          (defvar *old-standard-output* *standard-output*
+            "Keep track of current value standard output, this is restored after image restore completes")
+
+          (defun muffle-output ()
+            (setf *standard-output* (make-broadcast-stream)))
+
+          (defun restore-output ()
+            (setf *standard-output* *old-standard-output*))
+
+          (pushnew #'muffle-output ext:*after-save-initializations*)
+          (setf ext:*after-save-initializations*
+                (append ext:*after-save-initializations* (list #'restore-output))))