#:use-module (guix derivations)
#:use-module (guix build-system)
#:use-module (guix monads)
+ #:use-module (guix gexp)
#:use-module (guix ui)
#:use-module ((guix licenses)
#:select (gpl3+ license? license-name))
#:select (lookup-compressor self-contained-tarball))
#:use-module (gnu bootloader)
#:use-module (gnu bootloader u-boot)
+ #:use-module (gnu image)
#:use-module (gnu packages)
#:use-module (gnu packages gcc)
#:use-module (gnu packages base)
#:use-module (gnu packages make-bootstrap)
#:use-module (gnu packages package-management)
#:use-module (gnu system)
+ #:use-module (gnu system image)
#:use-module (gnu system vm)
#:use-module (gnu system install)
#:use-module (gnu tests)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
#:use-module (ice-9 match)
- #:export (channel-instance->package
+ #:export (%cross-targets
+ channel-source->package
hydra-jobs))
;;; Commentary:
%guile-bootstrap-tarball
%bootstrap-tarballs))
-(define %packages-to-cross-build
- %core-packages)
+(define (packages-to-cross-build target)
+ "Return the list of packages to cross-build for TARGET."
+ ;; Don't cross-build the bootstrap tarballs for MinGW.
+ (if (string-contains target "mingw")
+ (drop-right %core-packages 6)
+ %core-packages))
(define %cross-targets
'("mips64el-linux-gnu"
- "mips64el-linux-gnuabi64"
"arm-linux-gnueabihf"
"aarch64-linux-gnu"
"powerpc-linux-gnu"
(map (lambda (package)
(package-cross-job store (job-name package)
package target system))
- %packages-to-cross-build))
+ (packages-to-cross-build target)))
(remove (either from-32-to-64? same? pointless?)
%cross-targets)))
(expt 2 20))
(if (member system %guixsd-supported-systems)
- (if (member system %u-boot-systems)
- (list (->job 'flash-image
- (run-with-store store
- (mbegin %store-monad
- (set-guile-for-build (default-guile))
- (system-disk-image
- (operating-system (inherit installation-os)
- (bootloader (bootloader-configuration
- (bootloader u-boot-bootloader)
- (target #f))))
- #:disk-image-size
- (* 1500 MiB))))))
- (list (->job 'usb-image
- (run-with-store store
- (mbegin %store-monad
- (set-guile-for-build (default-guile))
- (system-disk-image installation-os
- #:disk-image-size
- (* 1500 MiB)))))
- (->job 'iso9660-image
- (run-with-store store
- (mbegin %store-monad
- (set-guile-for-build (default-guile))
- (system-disk-image installation-os
- #:file-system-type
- "iso9660"))))))
+ (list (->job 'usb-image
+ (run-with-store store
+ (mbegin %store-monad
+ (set-guile-for-build (default-guile))
+ (lower-object
+ (system-image
+ (image
+ (inherit efi-disk-image)
+ (size (* 1500 MiB))
+ (operating-system installation-os)))))))
+ (->job 'iso9660-image
+ (run-with-store store
+ (mbegin %store-monad
+ (set-guile-for-build (default-guile))
+ (lower-object
+ (system-image
+ (image
+ (inherit iso9660-image)
+ (operating-system installation-os))))))))
'()))
(define channel-build-system
;; Build system used to "convert" a channel instance to a package.
(let* ((build (lambda* (store name inputs
- #:key instance system
+ #:key source commit system
#:allow-other-keys)
(run-with-store store
- (channel-instances->derivation (list instance))
+ ;; SOURCE can be a lowerable object such as <local-file>
+ ;; or a file name. Adjust accordingly.
+ (mlet* %store-monad ((source (if (string? source)
+ (return source)
+ (lower-object source)))
+ (instance
+ -> (checkout->channel-instance
+ source #:commit commit)))
+ (channel-instances->derivation (list instance)))
#:system system)))
- (lower (lambda* (name #:key system instance #:allow-other-keys)
+ (lower (lambda* (name #:key system source commit
+ #:allow-other-keys)
(bag
(name name)
(system system)
(build build)
- (arguments `(#:instance ,instance))))))
+ (arguments `(#:source ,source
+ #:commit ,commit))))))
(build-system (name 'channel)
(description "Turn a channel instance into a package.")
(lower lower))))
-(define (channel-instance->package instance)
- "Return a package for the given channel INSTANCE."
+(define* (channel-source->package source #:key commit)
+ "Return a package for the given channel SOURCE, a lowerable object."
(package
(inherit guix)
- (version (or (string-take (channel-instance-commit instance) 7)
- (string-append (package-version guix) "+")))
+ (version (string-append (package-version guix) "+"))
(build-system channel-build-system)
- (arguments `(#:instance ,instance))
+ (arguments `(#:source ,source
+ #:commit ,commit))
(inputs '())
(native-inputs '())
(propagated-inputs '())))
(define* (system-test-jobs store system
#:key source commit)
"Return a list of jobs for the system tests."
- (define instance
- (checkout->channel-instance source #:commit commit))
-
(define (test->thunk test)
(lambda ()
(define drv
;; expensive. It also makes sure we get a valid Guix package when this
;; code is not running from a checkout.
(parameterize ((current-guix-package
- (channel-instance->package instance)))
+ (channel-source->package source #:commit commit)))
(map ->job (all-system-tests)))
'()))