04/27: vm: 'qemu-image' preserves the cross-compilation target of the OS.

[guix-commits]

janneke pushed a commit to branch wip-hurd-vm
in repository guix.

commit be5a401d5a5c2c1ef6dbfaced328cf1f3f6d68ce
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Thu May 28 00:37:33 2020 +0200

    vm: 'qemu-image' preserves the cross-compilation target of the OS.
    
    * 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 | 23 +++++++++++++++++++----
 1 file changed, 19 insertions(+), 4 deletions(-)

diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm
index c7767db..991ea2d 100644
--- a/gnu/system/vm.scm
+++ b/gnu/system/vm.scm
@@ -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