[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
01/03: ui: 'known-variable-definition' protects against module cycles.
From: |
Ludovic Courtès |
Subject: |
01/03: ui: 'known-variable-definition' protects against module cycles. |
Date: |
Fri, 24 Nov 2017 12:48:45 -0500 (EST) |
civodul pushed a commit to branch master
in repository guix.
commit b5bfa4773d50b12ec7e71e89892474e7f3c679ba
Author: Ludovic Courtès <address@hidden>
Date: Fri Nov 24 18:16:43 2017 +0100
ui: 'known-variable-definition' protects against module cycles.
Fixes <https://bugs.gnu.org/29358>.
Reported by Marius Bakke <address@hidden>.
* 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 0fc5ab6..ae727eb 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