summary refs log tree commit diff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2021-09-30 10:16:02 +0200
committerLudovic Courtès <ludo@gnu.org>2021-09-30 23:44:49 +0200
commitbedcba8f5cb6ab861d5379795fdb3698841c14b9 (patch)
tree6724c6af0004c5f97b24b90ddef71ff8f41756b7
parent270b30705dcca58d769a4ba8629cfb35eff32000 (diff)
downloadguix-bedcba8f5cb6ab861d5379795fdb3698841c14b9.tar.gz
discovery: Hide Guile warnings when loading modules.
Fixes <https://issues.guix.gnu.org/43747>.

* guix/discovery.scm (scheme-modules): Parameterize 'current-warning-port'.
-rw-r--r--guix/discovery.scm32
1 files changed, 19 insertions, 13 deletions
diff --git a/guix/discovery.scm b/guix/discovery.scm
index b84b9ff370..81d4ca600f 100644
--- a/guix/discovery.scm
+++ b/guix/discovery.scm
@@ -107,19 +107,25 @@ name and the exception key and arguments."
   (define prefix-len
     (string-length directory))
 
-  (filter-map (lambda (file)
-                (let* ((relative (string-drop file prefix-len))
-                       (module   (file-name->module-name relative)))
-                  (catch #t
-                    (lambda ()
-                      (resolve-interface module))
-                    (lambda args
-                      ;; Report the error, but keep going.
-                      (warn file module args)
-                      #f))))
-              (scheme-files (if sub-directory
-                                (string-append directory "/" sub-directory)
-                                directory))))
+  ;; Hide Guile warnings such as "source file [...] newer than compiled" when
+  ;; loading user code, unless we're hacking on Guix proper.  See
+  ;; <https://issues.guix.gnu.org/43747>.
+  (parameterize ((current-warning-port (if (getenv "GUIX_UNINSTALLED")
+                                           (current-warning-port)
+                                           (%make-void-port "w"))))
+    (filter-map (lambda (file)
+                  (let* ((relative (string-drop file prefix-len))
+                         (module   (file-name->module-name relative)))
+                    (catch #t
+                      (lambda ()
+                        (resolve-interface module))
+                      (lambda args
+                        ;; Report the error, but keep going.
+                        (warn file module args)
+                        #f))))
+                (scheme-files (if sub-directory
+                                  (string-append directory "/" sub-directory)
+                                  directory)))))
 
 (define* (scheme-modules* directory #:optional sub-directory)
   "Return the list of module names found under SUB-DIRECTORY in DIRECTORY.