summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2022-06-14 08:55:03 +0200
committerLudovic Courtès <ludo@gnu.org>2022-06-15 00:25:20 +0200
commit7046e777212233b89df68379c270b448c45195ce (patch)
treecee6e9f7aba177035aeb03b641979eb133a8fc21
parent9be470b5d2bab7ad2048c95815fee2916d45f4ad (diff)
system: <operating-system> compiler truly honors the 'system' argument.
Fixes <https://issues.guix.gnu.org/55951>. * gnu/system.scm (operating-system-compiler): Parameterize '%current-system' and '%current-target-system' before calling 'operating-system-derivation'. * tests/system.scm ("lower-object, %current-system sensitivity"): New test.
-rw-r--r--gnu/system.scm11
-rw-r--r--tests/system.scm21
2 files changed, 28 insertions, 4 deletions
diff --git a/gnu/system.scm b/gnu/system.scm
index 2c81478d00..ba1b7b5152 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -1582,8 +1582,13 @@ configurations."
(lambda (store)
;; XXX: This is not super elegant but we can't pass SYSTEM and TARGET to
;; 'operating-system-derivation'.
- (run-with-store store (operating-system-derivation os)
- #:system system
- #:target target)))))
+ (parameterize ((%current-system system)
+ (%current-target-system target))
+ (run-with-store store
+ (mbegin %store-monad
+ (set-guile-for-build (default-guile))
+ (operating-system-derivation os))
+ #:system system
+ #:target target))))))
;;; system.scm ends here
diff --git a/tests/system.scm b/tests/system.scm
index 019c720e65..873fed4aee 100644
--- a/tests/system.scm
+++ b/tests/system.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2016, 2018 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2016, 2018, 2022 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2017 Tobias Geerinckx-Rice <me@tobias.gr>
;;;
;;; This file is part of GNU Guix.
@@ -21,6 +21,10 @@
#:use-module (gnu)
#:use-module ((gnu services) #:select (service-value))
#:use-module (guix store)
+ #:use-module (guix monads)
+ #:use-module ((guix gexp) #:select (lower-object))
+ #:use-module ((guix utils) #:select (%current-system))
+ #:use-module (guix grafts)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-64))
@@ -64,6 +68,8 @@
%base-file-systems))
(users %base-user-accounts)))
+(%graft? #f)
+
(test-begin "system")
@@ -140,4 +146,17 @@
(type "ext4")
(dependencies (list %luks-device))))))))))
+(test-assert "lower-object, %current-system sensitivity"
+ ;; Make sure that 'lower-object' returns the same derivation, no matter what
+ ;; '%current-system' is. See <https://issues.guix.gnu.org/55951>.
+ (let ((drv1 (with-store store
+ (parameterize ((%current-system "x86_64-linux"))
+ (run-with-store store
+ (lower-object %os "aarch64-linux")))))
+ (drv2 (with-store store
+ (parameterize ((%current-system "aarch64-linux"))
+ (run-with-store store
+ (lower-object %os "aarch64-linux"))))))
+ (eq? drv1 drv2)))
+
(test-end)