vm: 'qemu-image' preserves the cross-compilation target of the OS.
authorLudovic Courtès <ludo@gnu.org>
Wed, 27 May 2020 22:37:33 +0000 (00:37 +0200)
committerLudovic Courtès <ludo@gnu.org>
Sat, 6 Jun 2020 21:28:49 +0000 (23:28 +0200)
* gnu/system/vm.scm (qemu-image)[preserve-target, inputs*]: New variables.
In gexp, use INPUTS* instead of INPUTS.  Wrap OS and BOOTCFG-DRV in
'preserve-target'.  Pass INPUTS* instead of INPUTS as the #:references-graphs.

gnu/system/vm.scm

index c7767db..991ea2d 100644 (file)
@@ -317,6 +317,21 @@ system that is passed to 'populate-root-file-system'."
          (local-file (search-path %load-path
                                   "guix/store/schema.sql"))))
 
+  (define preserve-target
+    (if target
+        (lambda (obj)
+          (with-parameters ((%current-target-system target))
+            obj))
+        identity))
+
+  (define inputs*
+    (map (match-lambda
+           ((name thing)
+            `(,name ,(preserve-target thing)))
+           ((name thing output)
+            `(,name ,(preserve-target thing) ,output)))
+         inputs))
+
   (expression->derivation-in-linux-vm
    name
    (with-extensions gcrypt-sqlite3&co
@@ -355,7 +370,7 @@ system that is passed to 'populate-root-file-system'."
                   '#$(map (match-lambda
                             ((name thing) thing)
                             ((name thing output) `(,thing ,output)))
-                          inputs)))
+                          inputs*)))
 
              (set-path-environment-variable "PATH" '("bin" "sbin") inputs)
 
@@ -367,7 +382,7 @@ system that is passed to 'populate-root-file-system'."
                                  #:closures graphs
                                  #:copy-closures? #$copy-inputs?
                                  #:register-closures? #$register-closures?
-                                 #:system-directory #$os
+                                 #:system-directory #$(preserve-target os)
 
                                  #:make-device-nodes
                                  #$(match device-nodes
@@ -423,7 +438,7 @@ system that is passed to 'populate-root-file-system'."
                                      #:grub-efi grub-efi
                                      #:bootloader-package
                                      #+(bootloader-package bootloader)
-                                     #:bootcfg #$bootcfg-drv
+                                     #:bootcfg #$(preserve-target bootcfg-drv)
                                      #:bootcfg-location
                                      #$(bootloader-configuration-file bootloader)
                                      #:bootloader-installer
@@ -432,7 +447,7 @@ system that is passed to 'populate-root-file-system'."
    #:make-disk-image? #t
    #:disk-image-size disk-image-size
    #:disk-image-format disk-image-format
-   #:references-graphs inputs
+   #:references-graphs inputs*
    #:substitutable? substitutable?))
 
 (define* (system-docker-image os