From b5bfa4773d50b12ec7e71e89892474e7f3c679ba Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 24 Nov 2017 18:16:43 +0100 Subject: ui: 'known-variable-definition' protects against module cycles. Fixes . Reported by Marius Bakke . * guix/ui.scm (known-variable-definition): Add 'visited' set to guard against cycles on 2.0. --- guix/ui.scm | 29 +++++++++++++++++------------ 1 file 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 -- cgit v1.2.3