[bug#73948] [PATCH 0/2] 'derivation-build-plan' returns builds in topological order

[bug#73948] [PATCH 0/2] 'derivation-build-plan' returns builds in topological order

[Ludovic Courtès]

Hello,

There’s one situation in ‘cuirass remote-worker’ where I found that it
would be more convenient for ‘derivation-build-plan’ to return the list of
builds in topological order, so a worker can perform them sequentially
in the right order.

From a UI viewpoint, it also seems to make more sense to display the
list of things to build in topological order.

Thoughts?

Ludo’.

Ludovic Courtès (2):
  derivations: ‘derivation-build-plan’ returns builds in topological
    order.
  ui: ‘show-what-to-build’ displays builds in topological order.

 guix/derivations.scm  | 74 +++++++++++++++++++++++++------------------
 guix/ui.scm           |  2 +-
 tests/derivations.scm | 31 ++++++++++++++++--
 3 files changed, 73 insertions(+), 34 deletions(-)


base-commit: 42612e3bdfb201dbd47d6b8ffc75345199a96a80
-- 
2.46.0

[bug#73948] [PATCH 1/2] derivations: ‘derivation-build-plan’ returns builds in topological order.

[Ludovic Courtès]

That makes ‘derivation-build-plan’ directly usable in cases where one
wants to sequentially build derivations one by one, or to report builds
in the right order in the user interface.

* guix/derivations.scm (derivation-build-plan): Wrap ‘loop’ in
‘traverse’.  Perform a depth-first traversal.  Return the list of builds
in topological order.
* tests/derivations.scm ("derivation-build-plan, topological ordering"):
New test.

Change-Id: I7cd9083f42c4381b4213794a40dbb5b234df966d
---
 guix/derivations.scm  | 74 +++++++++++++++++++++++++------------------
 tests/derivations.scm | 31 ++++++++++++++++--
 2 files changed, 72 insertions(+), 33 deletions(-)

diff --git a/guix/derivations.scm b/guix/derivations.scm
index a91c1ae984..bef98cd26a 100644
--- a/guix/derivations.scm
+++ b/guix/derivations.scm
@@ -401,8 +401,8 @@ (define* (derivation-build-plan store inputs
                                  (substitution-oracle
                                   store inputs #:mode mode)))
   "Given INPUTS, a list of derivation-inputs, return two values: the list of
-derivations to build, and the list of substitutable items that, together,
-allow INPUTS to be realized.
+derivations to build, in topological order, and the list of substitutable
+items that, together, allow INPUTS to be realized.
 
 SUBSTITUTABLE-INFO must be a one-argument procedure similar to that returned
 by 'substitution-oracle'."
@@ -422,36 +422,48 @@ (define* (derivation-build-plan store inputs
            (and (= (length info) (length items))
                 info))))
 
-  (let loop ((inputs     inputs)                  ;list of <derivation-input>
-             (build      '())                     ;list of <derivation>
-             (substitute '())                     ;list of <substitutable>
-             (visited    (set)))                  ;set of <derivation-input>
-    (match inputs
-      (()
-       (values build substitute))
-      ((input rest ...)
-       (let ((key  (derivation-input-key input))
-             (deps (derivation-inputs
-                    (derivation-input-derivation input))))
-         (cond ((set-contains? visited key)
-                (loop rest build substitute visited))
-               ((input-built? input)
-                (loop rest build substitute
-                      (set-insert key visited)))
-               ((input-substitutable-info input)
-                =>
-                (lambda (substitutables)
-                  (loop (append (dependencies-of-substitutables substitutables
+  (define (traverse)
+    ;; Perform a depth-first traversal.
+    (let loop ((inputs     inputs)                ;list of <derivation-input>
+               (build      '())                   ;list of <derivation>
+               (substitute '())                   ;list of <substitutable>
+               (visited    (set)))                ;set of <derivation-input>
+      (match inputs
+        (()
+         (values visited build substitute))
+        ((input rest ...)
+         (let ((key  (derivation-input-key input))
+               (deps (derivation-inputs
+                      (derivation-input-derivation input))))
+           (cond ((set-contains? visited key)
+                  (loop rest build substitute visited))
+                 ((input-built? input)
+                  (loop rest build substitute (set-insert key visited)))
+                 ((input-substitutable-info input)
+                  =>
+                  (lambda (substitutables)
+                    (call-with-values
+                        (lambda ()
+                          (loop (dependencies-of-substitutables substitutables
                                                                 deps)
-                                rest)
-                        build
-                        (append substitutables substitute)
-                        (set-insert key visited))))
-               (else
-                (loop (append deps rest)
-                      (cons (derivation-input-derivation input) build)
-                      substitute
-                      (set-insert key visited)))))))))
+                                build
+                                (append substitutables substitute)
+                                (set-insert key visited)))
+                      (lambda (visited build substitute)
+                        (loop rest build substitute visited)))))
+                 (else
+                  (call-with-values
+                      (lambda ()
+                        (loop deps build substitute (set-insert key visited)))
+                    (lambda (visited build substitute)
+                      (loop rest
+                            (cons (derivation-input-derivation input) build)
+                            substitute
+                            visited))))))))))
+
+  (call-with-values traverse
+    (lambda (_ build substitute)
+      (values (reverse! build) substitute))))
 
 (define-deprecated (derivation-prerequisites-to-build store drv #:rest rest)
   derivation-build-plan
diff --git a/tests/derivations.scm b/tests/derivations.scm
index 0e87778981..efcd21f324 100644
--- a/tests/derivations.scm
+++ b/tests/derivations.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012-2023 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012-2024 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -29,7 +29,8 @@ (define-module (test-derivations)
   #:use-module (guix tests git)
   #:use-module (guix tests http)
   #:use-module ((guix packages) #:select (package-derivation base32))
-  #:use-module ((guix build utils) #:select (executable-file?))
+  #:use-module ((guix build utils)
+                #:select (executable-file? strip-store-file-name))
   #:use-module ((guix hash) #:select (file-hash*))
   #:use-module ((git oid) #:select (oid->string))
   #:use-module ((git reference) #:select (reference-name->oid))
@@ -1157,6 +1158,32 @@ (define %coreutils
                                          #:mode (build-mode check))
                   (list drv dep))))))
 
+(test-equal "derivation-build-plan, topological ordering"
+  (make-list 5 '("0.drv" "1.drv" "2.drv" "3.drv" "4.drv"))
+  (with-store store
+    (define (test _)
+      (let* ((simple-derivation
+              (lambda (name . deps)
+                (build-expression->derivation
+                 store name
+                 `(begin ,(random-text) (mkdir %output))
+                 #:inputs (map (lambda (n dep)
+                                 (list (number->string n) dep))
+                               (iota (length deps))
+                               deps))))
+             (drv0 (simple-derivation "0"))
+             (drv1 (simple-derivation "1" drv0))
+             (drv2 (simple-derivation "2" drv1))
+             (drv3 (simple-derivation "3" drv2 drv0))
+             (drv4 (simple-derivation "4" drv3 drv1)))
+        (map (compose strip-store-file-name derivation-file-name)
+             (derivation-build-plan store (list (derivation-input drv4))))))
+
+    ;; This is probabilistic: if the traversal is buggy, it may or may not
+    ;; produce the wrong ordering, depending on a variety of actors.  Thus,
+    ;; try multiple times.
+    (map test (iota 5))))
+
 (test-assert "derivation-input-fold"
   (let* ((builder (add-text-to-store %store "my-builder.sh"
                                      "echo hello, world > \"$out\"\n"
-- 
2.46.0

[bug#73948] [PATCH 2/2] ui: ‘show-what-to-build’ displays builds in topological order.

[Ludovic Courtès]

That gives something like:

  $ ./pre-inst-env guix build vim --no-grafts --no-substitutes -n
  The following derivations would be built:
    /gnu/store/…-tcsh-6.24.01.tar.gz.drv
    /gnu/store/…-tcsh-6.24.01.tar.zst.drv
    /gnu/store/…-tcsh-6.24.01.drv
    /gnu/store/…-vim-9.1.0744-checkout.drv
    /gnu/store/…-vim-9.1.0744.drv

… with the derivation(s) being asked for coming last.

* guix/ui.scm (show-what-to-build): Reverse ‘build/full’ before folding it.

Change-Id: Ic0da9f4f8a58c7ed5e2d10f6ec2226f0865aed75
---
 guix/ui.scm | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/guix/ui.scm b/guix/ui.scm
index 966f0611f6..447550635c 100644
--- a/guix/ui.scm
+++ b/guix/ui.scm
@@ -1077,7 +1077,7 @@ (define* (show-what-to-build store drv
                                          #:hook ,hook
                                          #:build ,(cons file build))))))))
                               '(#:graft () #:hook () #:build ())
-                              build/full)
+                              (reverse! build/full)) ;preserve ordering
                    ((#:graft graft #:hook hook #:build build)
                     (values graft hook build)))))
     (define installed-size
-- 
2.46.0