summaryrefslogtreecommitdiff
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)
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