nixo
/
guix-devel
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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.
This commit is contained in:
Ludovic Courtès 2017-11-24 18:16:43 +01:00
parent 9c3c2caa6c
commit b5bfa4773d
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
1 changed files with 17 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
guix/ui.scm
View File

@ -28,6 +28,7 @@
(define-module (guix ui) (define-module (guix ui)
#:use-module (guix i18n) #:use-module (guix i18n)
#:use-module (guix gexp) #:use-module (guix gexp)
#:use-module (guix sets)
#:use-module (guix utils) #:use-module (guix utils)
#:use-module (guix store) #:use-module (guix store)
#:use-module (guix config) #:use-module (guix config)
@ -254,7 +255,8 @@ VARIABLE and return it, or #f if none was found."
(_ #f))) (_ #f)))
(let loop ((modules (list (resolve-module '() #f #f #:ensure #f))) (let loop ((modules (list (resolve-module '() #f #f #:ensure #f)))
(suggestions '())) (suggestions '())
(visited (setq)))
(match modules (match modules
(() (()
;; Pick the "best" suggestion. ;; Pick the "best" suggestion.
@ -262,16 +264,19 @@ VARIABLE and return it, or #f if none was found."
(() #f) (() #f)
((first _ ...) first))) ((first _ ...) first)))
((head tail ...) ((head tail ...)
(let ((next (append tail (if (set-contains? visited head)
(loop tail suggestions visited)
(let ((visited (set-insert head visited))
(next (append tail
(hash-map->list (lambda (name module) (hash-map->list (lambda (name module)
module) module)
(module-submodules head))))) (module-submodules head)))))
(match (module-local-variable head variable) (match (module-local-variable head variable)
(#f (loop next suggestions)) (#f (loop next suggestions visited))
(_ (_
(match (module-name head) (match (module-name head)
(('gnu _ ...) head) ;must be that one (('gnu _ ...) head) ;must be that one
(_ (loop next (cons head suggestions))))))))))) (_ (loop next (cons head suggestions) visited)))))))))))
(define* (display-hint message #:optional (port (current-error-port))) (define* (display-hint message #:optional (port (current-error-port)))
"Display MESSAGE, a l10n message possibly containing Texinfo markup, to "Display MESSAGE, a l10n message possibly containing Texinfo markup, to