diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2017-11-24 18:16:43 +0100 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2017-11-24 18:16:43 +0100 |
| commit | b5bfa4773d50b12ec7e71e89892474e7f3c679ba (patch) | |
| tree | ebcd69fbbb6fbcc1080ef6765201689f76344991 | |
| parent | 9c3c2caa6cb328610c99dd0699638a3ba41f7a64 (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.scm | 29 |
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 |