summary refs log tree commit diff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2017-11-24 18:16:43 +0100
committerLudovic Courtès <ludo@gnu.org>2017-11-24 18:16:43 +0100
commitb5bfa4773d50b12ec7e71e89892474e7f3c679ba (patch)
treeebcd69fbbb6fbcc1080ef6765201689f76344991
parent9c3c2caa6cb328610c99dd0699638a3ba41f7a64 (diff)
downloadguix-b5bfa4773d50b12ec7e71e89892474e7f3c679ba.tar.gz
ui: 'known-variable-definition' protects against module cycles.
Fixes <https://bugs.gnu.org/29358>.
Reported by Marius Bakke <mbakke@fastmail.com>.

* guix/ui.scm (known-variable-definition): Add 'visited' set to guard
against cycles on 2.0.
-rw-r--r--guix/ui.scm29
1 files changed, 17 insertions, 12 deletions
diff --git a/guix/ui.scm b/guix/ui.scm
index 0fc5ab63ad..ae727eb837 100644
--- a/guix/ui.scm
+++ b/guix/ui.scm
@@ -28,6 +28,7 @@
 (define-module (guix ui)
   #:use-module (guix i18n)
   #:use-module (guix gexp)
+  #:use-module (guix sets)
   #:use-module (guix utils)
   #:use-module (guix store)
   #:use-module (guix config)
@@ -253,8 +254,9 @@ VARIABLE and return it, or #f if none was found."
          (_ #t)))
       (_ #f)))
 
-  (let loop ((modules (list (resolve-module '() #f #f #:ensure #f)))
-             (suggestions '()))
+  (let loop ((modules     (list (resolve-module '() #f #f #:ensure #f)))
+             (suggestions '())
+             (visited     (setq)))
     (match modules
       (()
        ;; Pick the "best" suggestion.
@@ -262,16 +264,19 @@ VARIABLE and return it, or #f if none was found."
          (() #f)
          ((first _ ...) first)))
       ((head tail ...)
-       (let ((next (append tail
-                           (hash-map->list (lambda (name module)
-                                             module)
-                                           (module-submodules head)))))
-         (match (module-local-variable head variable)
-           (#f (loop next suggestions))
-           (_
-            (match (module-name head)
-              (('gnu _ ...) head)                 ;must be that one
-              (_ (loop next (cons head suggestions)))))))))))
+       (if (set-contains? visited head)
+           (loop tail suggestions visited)
+           (let ((visited (set-insert head visited))
+                 (next    (append tail
+                                  (hash-map->list (lambda (name module)
+                                                    module)
+                                                  (module-submodules head)))))
+             (match (module-local-variable head variable)
+               (#f (loop next suggestions visited))
+               (_
+                (match (module-name head)
+                  (('gnu _ ...) head)             ;must be that one
+                  (_ (loop next (cons head suggestions) visited)))))))))))
 
 (define* (display-hint message #:optional (port (current-error-port)))
   "Display MESSAGE, a l10n message possibly containing Texinfo markup, to