Take advantage of the new (guix platform) module
This means there's less reliance on the hardcoded lists of systems and targets and mappings between them.
This commit is contained in:
parent
786a5fa041
commit
fb8353559f
1 changed files with 70 additions and 22 deletions
|
|
@ -353,9 +353,30 @@ WHERE job_id = $1")
|
||||||
lock time-spent))
|
lock time-spent))
|
||||||
result)))))
|
result)))))
|
||||||
|
|
||||||
|
(define (inferior-guix-systems inf)
|
||||||
|
(cond
|
||||||
|
((inferior-eval
|
||||||
|
'(defined? 'systems
|
||||||
|
(resolve-module '(guix platform)))
|
||||||
|
inf)
|
||||||
|
|
||||||
|
(remove
|
||||||
|
(lambda (system)
|
||||||
|
;; There aren't currently bootstrap binaries for s390x-linux, so this
|
||||||
|
;; just leads to lots of errors
|
||||||
|
(string=? system "s390x-linux"))
|
||||||
|
(inferior-eval
|
||||||
|
'((@ (guix platform) systems))
|
||||||
|
inf)))
|
||||||
|
|
||||||
|
(else
|
||||||
|
(inferior-eval
|
||||||
|
'(@ (guix packages) %supported-systems)
|
||||||
|
inf))))
|
||||||
|
|
||||||
(define (all-inferior-system-tests inf store)
|
(define (all-inferior-system-tests inf store)
|
||||||
(define inferior-%supported-systems
|
(define inf-systems
|
||||||
(inferior-eval '(@ (guix packages) %supported-systems) inf))
|
(inferior-guix-systems inf))
|
||||||
|
|
||||||
(define extract
|
(define extract
|
||||||
`(lambda (store)
|
`(lambda (store)
|
||||||
|
|
@ -387,7 +408,7 @@ WHERE job_id = $1")
|
||||||
system
|
system
|
||||||
key args)
|
key args)
|
||||||
#f)))
|
#f)))
|
||||||
(list ,@inferior-%supported-systems))
|
(list ,@inf-systems))
|
||||||
(match (system-test-location system-test)
|
(match (system-test-location system-test)
|
||||||
(($ <location> file line column)
|
(($ <location> file line column)
|
||||||
(list file
|
(list file
|
||||||
|
|
@ -591,24 +612,37 @@ WHERE job_id = $1")
|
||||||
checkers))))
|
checkers))))
|
||||||
|
|
||||||
(define (all-inferior-package-derivations store inf packages)
|
(define (all-inferior-package-derivations store inf packages)
|
||||||
(define inferior-%supported-systems
|
(define inf-systems
|
||||||
(inferior-eval '(@ (guix packages) %supported-systems) inf))
|
(inferior-guix-systems inf))
|
||||||
|
|
||||||
|
(define inf-targets
|
||||||
|
(cond
|
||||||
|
((inferior-eval
|
||||||
|
'(defined? 'targets
|
||||||
|
(resolve-module '(guix platform)))
|
||||||
|
inf)
|
||||||
|
(inferior-eval
|
||||||
|
'((@ (guix platform) targets))
|
||||||
|
inf))
|
||||||
|
|
||||||
|
(else
|
||||||
|
'("arm-linux-gnueabihf"
|
||||||
|
"aarch64-linux-gnu"
|
||||||
|
"mips64el-linux-gnu"
|
||||||
|
"powerpc-linux-gnu"
|
||||||
|
"powerpc64le-linux-gnu"
|
||||||
|
"riscv64-linux-gnu"
|
||||||
|
"i586-pc-gnu"
|
||||||
|
"i686-w64-mingw32"
|
||||||
|
"x86_64-w64-mingw32"))))
|
||||||
|
|
||||||
(define cross-derivations
|
(define cross-derivations
|
||||||
`(("x86_64-linux" . ("arm-linux-gnueabihf"
|
`(("x86_64-linux" . ,inf-targets)))
|
||||||
"aarch64-linux-gnu"
|
|
||||||
"mips64el-linux-gnu"
|
|
||||||
"powerpc-linux-gnu"
|
|
||||||
"powerpc64le-linux-gnu"
|
|
||||||
"riscv64-linux-gnu"
|
|
||||||
"i586-pc-gnu"
|
|
||||||
"i686-w64-mingw32"
|
|
||||||
"x86_64-w64-mingw32"))))
|
|
||||||
|
|
||||||
(define supported-system-pairs
|
(define supported-system-pairs
|
||||||
(map (lambda (system)
|
(map (lambda (system)
|
||||||
(cons system #f))
|
(cons system #f))
|
||||||
inferior-%supported-systems))
|
inf-systems))
|
||||||
|
|
||||||
(define supported-system-cross-build-pairs
|
(define supported-system-cross-build-pairs
|
||||||
(append-map
|
(append-map
|
||||||
|
|
@ -622,13 +656,22 @@ WHERE job_id = $1")
|
||||||
(define (proc packages system-target-pairs)
|
(define (proc packages system-target-pairs)
|
||||||
`(lambda (store)
|
`(lambda (store)
|
||||||
(define target-system-alist
|
(define target-system-alist
|
||||||
'(("arm-linux-gnueabihf" . "armhf-linux")
|
(if (defined? 'platforms (resolve-module '(guix platform)))
|
||||||
("aarch64-linux-gnu" . "aarch64-linux")
|
(filter-map
|
||||||
("mips64el-linux-gnu" . "mips64el-linux")
|
(lambda (platform)
|
||||||
("powerpc-linux-gnu" . "powerpc-linux")
|
(and
|
||||||
("powerpc64le-linux-gnu" . "powerpc64le-linux")
|
(platform-target platform)
|
||||||
("riscv64-linux-gnu" . "riscv64-linux")
|
(cons (platform-target platform)
|
||||||
("i586-pc-gnu" . "i586-gnu")))
|
(platform-system platform))))
|
||||||
|
(platforms))
|
||||||
|
|
||||||
|
'(("arm-linux-gnueabihf" . "armhf-linux")
|
||||||
|
("aarch64-linux-gnu" . "aarch64-linux")
|
||||||
|
("mips64el-linux-gnu" . "mips64el-linux")
|
||||||
|
("powerpc-linux-gnu" . "powerpc-linux")
|
||||||
|
("powerpc64le-linux-gnu" . "powerpc64le-linux")
|
||||||
|
("riscv64-linux-gnu" . "riscv64-linux")
|
||||||
|
("i586-pc-gnu" . "i586-gnu"))))
|
||||||
|
|
||||||
(define package-transitive-supported-systems-supports-multiple-arguments? #t)
|
(define package-transitive-supported-systems-supports-multiple-arguments? #t)
|
||||||
(define (get-supported-systems package system)
|
(define (get-supported-systems package system)
|
||||||
|
|
@ -749,6 +792,11 @@ WHERE job_id = $1")
|
||||||
'()))))))
|
'()))))))
|
||||||
(list ,@(map inferior-package-id packages)))))
|
(list ,@(map inferior-package-id packages)))))
|
||||||
|
|
||||||
|
(inferior-eval
|
||||||
|
'(when (defined? 'systems (resolve-module '(guix platform)))
|
||||||
|
(use-modules (guix platform)))
|
||||||
|
inf)
|
||||||
|
|
||||||
(append-map
|
(append-map
|
||||||
(lambda (system-target-pair)
|
(lambda (system-target-pair)
|
||||||
(format (current-error-port)
|
(format (current-error-port)
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue