02/08: discovery: Hide Guile warnings when loading modules.

[guix-commits]

civodul pushed a commit to branch master
in repository guix.

commit bedcba8f5cb6ab861d5379795fdb3698841c14b9
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Thu Sep 30 10:16:02 2021 +0200

    discovery: Hide Guile warnings when loading modules.
    
    Fixes <https://issues.guix.gnu.org/43747>.
    
    * guix/discovery.scm (scheme-modules): Parameterize 'current-warning-port'.
---
 guix/discovery.scm | 32 +++++++++++++++++++-------------
 1 file changed, 19 insertions(+), 13 deletions(-)

diff --git a/guix/discovery.scm b/guix/discovery.scm
index b84b9ff..81d4ca6 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.