ci: Build Guix System images.
Build a list of Guix System images. For now, this list only contains the Hurd barebones Guix System image. * gnu/ci.scm (%guixsd-supported-systems): Remove "armhf-linux", (%u-boot-systems): remove unused variable, (%guix-system-images): new variable (qemu-jobs): rename to "image-jobs" and build the Guix Systems listed in the new "%guix-system-images" variable, (system-test-jobs): adapt accordingly, (hydra-jobs): ditto.
This commit is contained in:
parent
fab8fed355
commit
b06ba9e0ff
72
gnu/ci.scm
72
gnu/ci.scm
|
@ -53,6 +53,7 @@
|
||||||
#:use-module (gnu system image)
|
#:use-module (gnu system image)
|
||||||
#:use-module (gnu system vm)
|
#:use-module (gnu system vm)
|
||||||
#:use-module (gnu system install)
|
#:use-module (gnu system install)
|
||||||
|
#:use-module (gnu system images hurd)
|
||||||
#:use-module (gnu tests)
|
#:use-module (gnu tests)
|
||||||
#:use-module (srfi srfi-1)
|
#:use-module (srfi srfi-1)
|
||||||
#:use-module (srfi srfi-26)
|
#:use-module (srfi srfi-26)
|
||||||
|
@ -185,18 +186,21 @@ SYSTEM."
|
||||||
(remove (either from-32-to-64? same? pointless?)
|
(remove (either from-32-to-64? same? pointless?)
|
||||||
%cross-targets)))
|
%cross-targets)))
|
||||||
|
|
||||||
(define %guixsd-supported-systems
|
;; Architectures that are able to build or cross-build Guix System images.
|
||||||
'("x86_64-linux" "i686-linux" "armhf-linux"))
|
;; This does not mean that other architectures are not supported, only that
|
||||||
|
;; they are often not fast enough to support Guix System images building.
|
||||||
|
(define %guix-system-supported-systems
|
||||||
|
'("x86_64-linux" "i686-linux"))
|
||||||
|
|
||||||
(define %u-boot-systems
|
(define %guix-system-images
|
||||||
'("armhf-linux"))
|
(list hurd-barebones-disk-image))
|
||||||
|
|
||||||
(define (qemu-jobs store system)
|
(define (image-jobs store system)
|
||||||
"Return a list of jobs that build QEMU images for SYSTEM."
|
"Return a list of jobs that build images for SYSTEM."
|
||||||
(define (->alist drv)
|
(define (->alist drv)
|
||||||
`((derivation . ,(derivation-file-name drv))
|
`((derivation . ,(derivation-file-name drv))
|
||||||
(description . "Stand-alone QEMU image of the GNU system")
|
(description . "Stand-alone image of the GNU system")
|
||||||
(long-description . "This is a demo stand-alone QEMU image of the GNU
|
(long-description . "This is a demo stand-alone image of the GNU
|
||||||
system.")
|
system.")
|
||||||
(license . ,(license-name gpl3+))
|
(license . ,(license-name gpl3+))
|
||||||
(max-silent-time . 600)
|
(max-silent-time . 600)
|
||||||
|
@ -211,29 +215,33 @@ system.")
|
||||||
(parameterize ((%graft? #f))
|
(parameterize ((%graft? #f))
|
||||||
(->alist drv))))))
|
(->alist drv))))))
|
||||||
|
|
||||||
|
(define (build-image image)
|
||||||
|
(run-with-store store
|
||||||
|
(mbegin %store-monad
|
||||||
|
(set-guile-for-build (default-guile))
|
||||||
|
(lower-object (system-image image)))))
|
||||||
|
|
||||||
(define MiB
|
(define MiB
|
||||||
(expt 2 20))
|
(expt 2 20))
|
||||||
|
|
||||||
(if (member system %guixsd-supported-systems)
|
(if (member system %guix-system-supported-systems)
|
||||||
(list (->job 'usb-image
|
`(,(->job 'usb-image
|
||||||
(run-with-store store
|
(build-image
|
||||||
(mbegin %store-monad
|
(image
|
||||||
(set-guile-for-build (default-guile))
|
(inherit efi-disk-image)
|
||||||
(lower-object
|
(size (* 1500 MiB))
|
||||||
(system-image
|
(operating-system installation-os))))
|
||||||
(image
|
,(->job 'iso9660-image
|
||||||
(inherit efi-disk-image)
|
(build-image
|
||||||
(size (* 1500 MiB))
|
(image
|
||||||
(operating-system installation-os)))))))
|
(inherit iso9660-image)
|
||||||
(->job 'iso9660-image
|
(operating-system installation-os))))
|
||||||
(run-with-store store
|
;; Only cross-compile Guix System images from x86_64-linux for now.
|
||||||
(mbegin %store-monad
|
,@(if (string=? system "x86_64-linux")
|
||||||
(set-guile-for-build (default-guile))
|
(map (lambda (image)
|
||||||
(lower-object
|
(->job (image-name image) (build-image image)))
|
||||||
(system-image
|
%guix-system-images)
|
||||||
(image
|
'()))
|
||||||
(inherit iso9660-image)
|
|
||||||
(operating-system installation-os))))))))
|
|
||||||
'()))
|
'()))
|
||||||
|
|
||||||
(define channel-build-system
|
(define channel-build-system
|
||||||
|
@ -305,11 +313,7 @@ system.")
|
||||||
"." system))))
|
"." system))))
|
||||||
(cons name (test->thunk test))))
|
(cons name (test->thunk test))))
|
||||||
|
|
||||||
(if (and (member system %guixsd-supported-systems)
|
(if (member system %guix-system-supported-systems)
|
||||||
|
|
||||||
;; XXX: Our build farm has too few ARMv7 machines and they are very
|
|
||||||
;; slow, so skip system tests there.
|
|
||||||
(not (string=? system "armhf-linux")))
|
|
||||||
;; Override the value of 'current-guix' used by system tests. Using a
|
;; Override the value of 'current-guix' used by system tests. Using a
|
||||||
;; channel instance makes tests that rely on 'current-guix' less
|
;; channel instance makes tests that rely on 'current-guix' less
|
||||||
;; expensive. It also makes sure we get a valid Guix package when this
|
;; expensive. It also makes sure we get a valid Guix package when this
|
||||||
|
@ -486,7 +490,7 @@ Return #f if no such checkout is found."
|
||||||
(package->job store package
|
(package->job store package
|
||||||
system))))
|
system))))
|
||||||
(append (filter-map job all)
|
(append (filter-map job all)
|
||||||
(qemu-jobs store system)
|
(image-jobs store system)
|
||||||
(system-test-jobs store system
|
(system-test-jobs store system
|
||||||
#:source source
|
#:source source
|
||||||
#:commit commit)
|
#:commit commit)
|
||||||
|
|
Loading…
Reference in New Issue