diff options
| -rw-r--r-- | gnu/system.scm | 11 | ||||
| -rw-r--r-- | tests/system.scm | 21 |
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) |