aboutsummaryrefslogtreecommitdiff
path: root/gnu/ci.scm
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2019-01-20 00:20:34 +0100
committerLudovic Courtès <ludo@gnu.org>2019-01-20 01:42:11 +0100
commit7e6d8d366a61f951936ed83371877ce006f679f6 (patch)
tree76f2bdc2143775643fa3cebf27af684caaddcbff /gnu/ci.scm
parent38b77f34640ff8a491913d29abcd16a846f2d0e4 (diff)
downloadguix-7e6d8d366a61f951936ed83371877ce006f679f6.tar
guix-7e6d8d366a61f951936ed83371877ce006f679f6.tar.gz
ci: Use a valid 'current-guix'.
This fixes a regression introduced in b5f8c2c88543158e8aca76aa98f9009f6b9e743a whereby 'current-guix' (needed by some of the system tests) would fail to build. Reported by Ricardo Wurmus <rekado@elephly.net>. It also speeds up compilation of 'current-guix' since the channel instance is already compiled or can be built quickly compared to the default 'current-guix'. * gnu/packages/package-management.scm (current-guix-package): New variable. (current-guix): Honor it. * gnu/ci.scm (channel-build-system): New variable. (channel-instances->derivation): New procedure. (system-test-jobs): Add #:source and #:commit parameters. Define 'instance' and parameterize CURRENT-GUIX-PACKAGE. (hydra-jobs)[checkout, commit, source]: New variables. Pass #:source and #:commit to 'system-test-jobs'.
Diffstat (limited to 'gnu/ci.scm')
-rw-r--r--gnu/ci.scm65
1 files changed, 61 insertions, 4 deletions
diff --git a/gnu/ci.scm b/gnu/ci.scm
index c071f21e0a..943fbb6af6 100644
--- a/gnu/ci.scm
+++ b/gnu/ci.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2017 Jan Nieuwenhuizen <janneke@gnu.org>
;;; Copyright © 2018 Clément Lassieur <clement@lassieur.org>
;;;
@@ -24,7 +24,9 @@
#:use-module (guix grafts)
#:use-module (guix profiles)
#:use-module (guix packages)
+ #:use-module (guix channels)
#:use-module (guix derivations)
+ #:use-module (guix build-system)
#:use-module (guix monads)
#:use-module (guix ui)
#:use-module ((guix licenses)
@@ -188,8 +190,40 @@ system.")
"iso9660"))))))
'()))
-(define (system-test-jobs store system)
+(define channel-build-system
+ ;; Build system used to "convert" a channel instance to a package.
+ (let* ((build (lambda* (store name inputs
+ #:key instance #:allow-other-keys)
+ (run-with-store store
+ (channel-instances->derivation (list instance)))))
+ (lower (lambda* (name #:key system instance #:allow-other-keys)
+ (bag
+ (name name)
+ (system system)
+ (build build)
+ (arguments `(#:instance ,instance))))))
+ (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."
+ (package
+ (inherit guix)
+ (version (or (string-take (channel-instance-commit instance) 7)
+ (string-append (package-version guix) "+")))
+ (build-system channel-build-system)
+ (arguments `(#:instance ,instance))
+ (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
@@ -217,7 +251,13 @@ system.")
(cons name (test->thunk test))))
(if (member system %guixsd-supported-systems)
- (map ->job (all-system-tests))
+ ;; Override the value of 'current-guix' used by system tests. Using a
+ ;; channel instance makes tests that rely on 'current-guix' less
+ ;; 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)))
+ (map ->job (all-system-tests)))
'()))
(define (tarball-jobs store system)
@@ -343,6 +383,21 @@ valid."
((lst ...) lst)
((? string? str) (call-with-input-string str read))))
+ (define checkout
+ ;; Extract metadata about the 'guix' checkout. Its key in ARGUMENTS may
+ ;; vary, so pick up the first one that's neither 'subset' nor 'systems'.
+ (any (match-lambda
+ ((key . value)
+ (and (not (memq key '(systems subset)))
+ value)))
+ arguments))
+
+ (define commit
+ (assq-ref checkout 'revision))
+
+ (define source
+ (assq-ref checkout 'file-name))
+
(define (cross-jobs system)
(define (from-32-to-64? target)
;; Return true if SYSTEM is 32-bit and TARGET is 64-bit. This hack
@@ -405,7 +460,9 @@ valid."
system))))
(append (filter-map job all)
(qemu-jobs store system)
- (system-test-jobs store system)
+ (system-test-jobs store system
+ #:source source
+ #:commit commit)
(tarball-jobs store system)
(cross-jobs system))))
((core)