summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2026-03-14 11:18:30 +0100
committerLudovic Courtès <ludo@gnu.org>2026-03-25 23:51:26 +0100
commitea827812f2b2dbc569f4b3478c3bc4645ea2eb15 (patch)
treefd08e7ab4f678891933d6dd0807b0de91b8fca31
parentac1a7cd864e30df462a8f2d667342cba3dbcfa7b (diff)
channels: Resolve dependencies recursively.
* guix/channels.scm (closure): New procedure. (resolve-dependencies): Use it. * tests/channels.scm ("channel-instance-dependency-resolver"): New test. Fixes: https://issues.guix.gnu.org/68797 Change-Id: Iaba4f54261e33e18bd57a0a319aa099f259b8570 Signed-off-by: Ludovic Courtès <ludo@gnu.org> Merges: #7137
-rw-r--r--guix/channels.scm28
-rw-r--r--tests/channels.scm57
2 files changed, 82 insertions, 3 deletions
diff --git a/guix/channels.scm b/guix/channels.scm
index e7afa60c1ea..ebd09eba8d1 100644
--- a/guix/channels.scm
+++ b/guix/channels.scm
@@ -50,6 +50,7 @@
50 #:use-module (guix diagnostics) 50 #:use-module (guix diagnostics)
51 #:use-module (guix store) 51 #:use-module (guix store)
52 #:use-module (guix i18n) 52 #:use-module (guix i18n)
53 #:autoload (guix sets) (setq set-insert set-contains?)
53 #:use-module (srfi srfi-1) 54 #:use-module (srfi srfi-1)
54 #:use-module (srfi srfi-2) 55 #:use-module (srfi srfi-2)
55 #:use-module (srfi srfi-9) 56 #:use-module (srfi srfi-9)
@@ -91,6 +92,8 @@
91 channel-instance-channel 92 channel-instance-channel
92 channel-instance-commit 93 channel-instance-commit
93 channel-instance-checkout 94 channel-instance-checkout
95 channel-instance-dependencies
96 (resolve-dependencies . channel-instance-dependency-resolver)
94 97
95 authenticate-channel 98 authenticate-channel
96 latest-channel-instances 99 latest-channel-instances
@@ -791,9 +794,24 @@ during this process."
791 #:built-in-builders 794 #:built-in-builders
792 built-in-builders)) 795 built-in-builders))
793 796
797(define (closure node edge)
798 "Return the closure of NODE following EDGE, a one-argument procedure, but
799not NODE itself."
800 (let loop ((nodes (edge node))
801 (visited (setq))
802 (result '()))
803 (match nodes
804 (() result)
805 ((head . tail)
806 (if (set-contains? visited head)
807 (loop tail visited result)
808 (loop (append (edge head) tail)
809 (set-insert head visited)
810 (cons head result)))))))
811
794(define (resolve-dependencies instances) 812(define (resolve-dependencies instances)
795 "Return a procedure that, given one of the elements of INSTANCES, returns 813 "Return a procedure that, given one of the elements of INSTANCES, returns
796list of instances it depends on." 814list of instances it depends on, recursively."
797 (define channel-instance-name 815 (define channel-instance-name
798 (compose channel-name channel-instance-channel)) 816 (compose channel-name channel-instance-channel))
799 817
@@ -817,7 +835,13 @@ list of instances it depends on."
817 instances)) 835 instances))
818 836
819 (lambda (instance) 837 (lambda (instance)
820 (vhash-foldq* cons '() instance edges))) 838 ;; Return both direct and indirect dependencies of INSTANCE. That way, if
839 ;; INSTANCE uses a module of one of its direct dependencies, which in turn
840 ;; uses a module of an indirect dependency, INSTANCE will has access to
841 ;; the module of that indirect dependency.
842 (closure instance
843 (lambda (instance)
844 (vhash-foldq* cons '() instance edges)))))
821 845
822(define* (channel-instance-derivations instances #:key system 846(define* (channel-instance-derivations instances #:key system
823 built-in-builders) 847 built-in-builders)
diff --git a/tests/channels.scm b/tests/channels.scm
index 15deb551ffa..2df4c86b5a8 100644
--- a/tests/channels.scm
+++ b/tests/channels.scm
@@ -1,6 +1,6 @@
1;;; GNU Guix --- Functional package management for GNU 1;;; GNU Guix --- Functional package management for GNU
2;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net> 2;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net>
3;;; Copyright © 2019-2020, 2022, 2024 Ludovic Courtès <ludo@gnu.org> 3;;; Copyright © 2019-2020, 2022, 2024, 2026 Ludovic Courtès <ludo@gnu.org>
4;;; 4;;;
5;;; This file is part of GNU Guix. 5;;; This file is part of GNU Guix.
6;;; 6;;;
@@ -278,6 +278,61 @@
278 #:current-channels (list new) 278 #:current-channels (list new)
279 #:validate-pull validate-pull))))))) 279 #:validate-pull validate-pull)))))))
280 280
281(test-equal "channel-instance-dependency-resolver"
282 '((c => (a b)) (b => (a)) (a => ()))
283 ;; Check that channel dependencies propagate. Here we create three channels
284 ;; that depend on one another: c depends on b, which depends on a. When
285 ;; resolving dependencies for c, we must get both a and b, such that
286 ;; (use-modules (b)) from channel c finds (a) when building the derivation
287 ;; of channel c. See <https://issues.guix.gnu.org/68797>.
288 (let ((call-with-channel
289 (lambda (name dependencies channels proc)
290 (with-temporary-git-repository directory
291 `((add ,(string-append (symbol->string name) ".scm")
292 ,(object->string
293 `(define-module (,name)
294 ,@(append-map (lambda (dependency)
295 `(#:use-module (,dependency)))
296 dependencies))))
297 (add ".guix-channel"
298 ,(object->string
299 `(channel
300 (version 0)
301 (dependencies
302 ,@(map (lambda (dependency)
303 `(channel
304 (name ,dependency)
305 (url "http://example.org")))
306 dependencies)))))
307 (commit "Initial commit."))
308 (proc (cons (channel
309 (name name)
310 (url directory))
311 channels))))))
312 (define-syntax with-channels
313 (syntax-rules (&initialized)
314 ((_ &initialized binding (name dependencies) rest ... exp)
315 (call-with-channel 'name dependencies binding
316 (lambda (binding)
317 (with-channels &initialized binding
318 rest ... exp))))
319 ((_ &initialized binding exp) exp)
320 ((_ binding rest ...)
321 (let ((binding '()))
322 (with-channels &initialized binding rest ...)))))
323
324 (with-channels
325 channels (a '()) (b '(a)) (c '(b))
326 (with-store store
327 (let* ((instances (latest-channel-instances store channels))
328 (resolve (channel-instance-dependency-resolver instances)))
329 (map (lambda (instance)
330 (list (channel-name (channel-instance-channel instance))
331 '=>
332 (map (compose channel-name channel-instance-channel)
333 (resolve instance))))
334 instances))))))
335
281(test-assert "channel-instances->manifest" 336(test-assert "channel-instances->manifest"
282 ;; Compute the manifest for a graph of instances and make sure we get a 337 ;; Compute the manifest for a graph of instances and make sure we get a
283 ;; derivation graph that mirrors the instance graph. This test also ensures 338 ;; derivation graph that mirrors the instance graph. This test also ensures