me
/
guix
Archived
1
0
Fork 0
Code

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.
Ludovic Courtès 2022-06-14 08:55:03 +02:00
parent 9be470b5d2
commit 7046e77721
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
2 changed files with 28 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
gnu/system.scm
View File

@ -1582,8 +1582,13 @@ configurations."
(lambda (store) (lambda (store)
;; XXX: This is not super elegant but we can't pass SYSTEM and TARGET to ;; XXX: This is not super elegant but we can't pass SYSTEM and TARGET to
;; 'operating-system-derivation'. ;; 'operating-system-derivation'.
(run-with-store store (operating-system-derivation os) (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 #:system system
#:target target))))) #:target target))))))
;;; system.scm ends here ;;; system.scm ends here

21
tests/system.scm
View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; 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> ;;; Copyright © 2017 Tobias Geerinckx-Rice <me@tobias.gr>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
@ -21,6 +21,10 @@
#:use-module (gnu) #:use-module (gnu)
#:use-module ((gnu services) #:select (service-value)) #:use-module ((gnu services) #:select (service-value))
#:use-module (guix store) #: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-1)
#:use-module (srfi srfi-64)) #:use-module (srfi srfi-64))
@ -64,6 +68,8 @@
%base-file-systems)) %base-file-systems))
(users %base-user-accounts))) (users %base-user-accounts)))
(%graft? #f)
(test-begin "system") (test-begin "system")
@ -140,4 +146,17 @@
(type "ext4") (type "ext4")
(dependencies (list %luks-device)))))))))) (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) (test-end)