From 5bbb9af5d99314a79d7f6535d9a3176c2c10e60b Mon Sep 17 00:00:00 2001
From: Mathieu Othacehe <othacehe@gnu.org>
Date: Wed, 17 Aug 2022 11:22:22 +0200
Subject: [PATCH] ci: Fix the images specification.

If the current-guix-package parameter is not set, Cuirass will try to update
the in-store Git checkout used by the evaluate.scm inferior:

ice-9/boot-9.scm:1685:16: In procedure raise-exception: ERROR:
1. &inferior-exception: arguments: (git-error #<inferior-object #<<git-error>
code: -3 message: "could not find repository from
'/gnu/store/v33m82qzkvd96dlp2g83dvz62n4pkad2-guix-20d8081'" class: 6>>)
inferior: #<inferior pipe (0 1 1) 7f7948957dc0>
stack: ((#f ("ice-9/boot-9.scm" 1779 13)) (raise-exception ("ice-9/boot-9.scm"
1682 16)) (raise-exception ("ice-9/boot-9.scm" 1684 16)) (#f ("guix/git.scm"
395 13))

This is a follow-up of: 5bce4c82422de6beb3ce6120ba1592be898c2b72.

* gnu/ci.scm (image-jobs): Add source and commit arguments.
Use them to set the current-guix-package parameter.
(cuirass-jobs): Adapt accordingly.
---
 gnu/ci.scm | 61 +++++++++++++++++++++++++++++-------------------------
 1 file changed, 33 insertions(+), 28 deletions(-)

diff --git a/gnu/ci.scm b/gnu/ci.scm
index 9cc3a1a81f..2c51ea7387 100644
--- a/gnu/ci.scm
+++ b/gnu/ci.scm
@@ -254,37 +254,40 @@ otherwise use the IMAGE name."
     (parameterize ((%graft? #f))
       (derivation->job name drv))))
 
-(define (image-jobs store system)
+(define* (image-jobs store system
+                     #:key source commit)
   "Return a list of jobs that build images for SYSTEM."
   (define MiB
     (expt 2 20))
 
-  (if (member system %guix-system-supported-systems)
-      `(,(image->job store
-                     (image
-                      (inherit efi-disk-image)
-                      (operating-system installation-os))
-                     #:name "usb-image"
-                     #:system system)
-        ,(image->job
-          store
-          (image
-           (inherit (image-with-label
-                     iso9660-image
-                     (string-append "GUIX_" system "_"
-                                    (if (> (string-length %guix-version) 7)
-                                        (substring %guix-version 0 7)
-                                        %guix-version))))
-           (operating-system installation-os))
-          #:name "iso9660-image"
-          #:system system)
-        ;; Only cross-compile Guix System images from x86_64-linux for now.
-        ,@(if (string=? system "x86_64-linux")
-              (map (cut image->job store <>
-                        #:system system)
-                   %guix-system-images)
-              '()))
-      '()))
+  (parameterize ((current-guix-package
+                  (channel-source->package source #:commit commit)))
+    (if (member system %guix-system-supported-systems)
+        `(,(image->job store
+                       (image
+                        (inherit efi-disk-image)
+                        (operating-system installation-os))
+                       #:name "usb-image"
+                       #:system system)
+          ,(image->job
+            store
+            (image
+             (inherit (image-with-label
+                       iso9660-image
+                       (string-append "GUIX_" system "_"
+                                      (if (> (string-length %guix-version) 7)
+                                          (substring %guix-version 0 7)
+                                          %guix-version))))
+             (operating-system installation-os))
+            #:name "iso9660-image"
+            #:system system)
+          ;; Only cross-compile Guix System images from x86_64-linux for now.
+          ,@(if (string=? system "x86_64-linux")
+                (map (cut image->job store <>
+                          #:system system)
+                     %guix-system-images)
+                '()))
+        '())))
 
 (define* (system-test-jobs store system
                            #:key source commit)
@@ -527,7 +530,9 @@ names."
                                hello system))))
          ('images
           ;; Build Guix System images only.
-          (image-jobs store system))
+          (image-jobs store system
+                      #:source source
+                      #:commit commit))
          ('system-tests
           ;; Build Guix System tests only.
           (system-test-jobs store system