ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-12-24 05:18:07 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

hydra: Compute jobs in an inferior.

Browse source 
Previously we would rely on auto-compilation of all the Guix modules.
The complete evaluation would take ~15mn on berlin.guixsd.org and
require lots of RAM.  This approach should be faster since potentially
only part of the modules are rebuilt.  Furthermore, as a side-effect, it
builds the derivations that 'guix pull' uses.

* build-aux/hydra/gnu-system.scm: Remove 'eval-when' form.
(hydra-jobs): New procedure.
* gnu/ci.scm (package->alist, qemu-jobs, system-test-jobs)
(tarball-jobs): Return strings for the 'license' field.
* guix/self.scm (compiled-guix)[*cli-modules*]: Add (gnu ci).
This commit is contained in:
Ludovic Courtès 2018-11-26 17:17:45 +01:00
parent 65ff85dcee
commit b5f8c2c885
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
3 changed files with 64 additions and 36 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

77
build-aux/hydra/gnu-system.scm
View file

@ -23,39 +23,56 @@
;;; tool.
;;;
(use-modules (system base compile))
(eval-when (expand load eval)
;; Pre-load the compiler so we don't end up auto-compiling it.
(compile #t)
;; Use our very own Guix modules.
(set! %fresh-auto-compile #t)
;; Ignore .go files except for Guile's. This is because our checkout in the
;; store has mtime set to the epoch, and thus .go files look newer, even
;; though they may not correspond. Use 'reverse' so that /gnu/store/…-guile
;; comes before /run/current-system/profile.
(set! %load-compiled-path
(list
(dirname (dirname (search-path (reverse %load-compiled-path)
"ice-9/boot-9.go")))))
(and=> (assoc-ref (current-source-location) 'filename)
(lambda (file)
(let ((dir (canonicalize-path
(string-append (dirname file) "/../.."))))
(format (current-error-port) "prepending ~s to the load path~%"
dir)
(set! %load-path (cons dir %load-path))))))
(use-modules (gnu ci))
(use-modules (guix inferior) (guix channels)
(guix)
(guix ui)
(srfi srfi-1)
(ice-9 match))
;; XXX: Debugging hack: since `hydra-eval-guile-jobs' redirects the output
;; port to the bit bucket, let us write to the error port instead.
(setvbuf (current-error-port) _IOLBF)
(set-current-output-port (current-error-port))
;; Return the procedure from (gnu ci).
hydra-jobs
(define (hydra-jobs store arguments)
"Return a list of jobs where each job is a NAME/THUNK pair."
(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 instance
(checkout->channel-instance source #:commit commit))
(define derivation
;; Compute the derivation of Guix for COMMIT.
(run-with-store store
(channel-instances->derivation (list instance))))
(show-what-to-build store (list derivation))
(build-derivations store (list derivation))
;; Open an inferior for the just-built Guix.
(let ((inferior (open-inferior (derivation->output-path derivation))))
(inferior-eval '(use-modules (gnu ci) (ice-9 match)) inferior)
(map (match-lambda
((name . fields)
;; Hydra expects a thunk, so here it is.
(cons name (lambda () fields))))
(inferior-eval-with-store inferior store
`(lambda (store)
(map (match-lambda
((name . thunk)
(cons name (thunk))))
(hydra-jobs store ',arguments)))))))

20
gnu/ci.scm
View file

@ -27,7 +27,8 @@ (define-module (gnu ci)
#:use-module (guix derivations)
#:use-module (guix monads)
#:use-module (guix ui)
#:use-module ((guix licenses) #:select (gpl3+))
#:use-module ((guix licenses)
#:select (gpl3+ license? license-name))
#:use-module ((guix utils) #:select (%current-system))
#:use-module ((guix scripts system) #:select (read-operating-system))
#:use-module ((guix scripts pack)
@ -69,7 +70,16 @@ (define* (package->alist store package system
#:graft? #f)))
(description . ,(package-synopsis package))
(long-description . ,(package-description package))
(license . ,(package-license package))
;; XXX: Hydra ignores licenses that are not a <license> structure or a
;; list thereof.
(license . ,(let loop ((license (package-license package)))
(match license
((? license?)
(license-name license))
((lst ...)
(map loop license)))))
(home-page . ,(package-home-page package))
(maintainers . ("bug-guix@gnu.org"))
(max-silent-time . ,(or (assoc-ref (package-properties package)
@ -133,7 +143,7 @@ (define (->alist drv)
(description . "Stand-alone QEMU image of the GNU system")
(long-description . "This is a demo stand-alone QEMU image of the GNU
system.")
(license . ,gpl3+)
(license . ,(license-name gpl3+))
(max-silent-time . 600)
(timeout . 3600)
(home-page . ,%guix-home-page-url)
@ -194,7 +204,7 @@ (define drv
(description . ,(format #f "GuixSD '~a' system test"
(system-test-name test)))
(long-description . ,(system-test-description test))
(license . ,gpl3+)
(license . ,(license-name gpl3+))
(max-silent-time . 600)
(timeout . 3600)
(home-page . ,%guix-home-page-url)
@ -217,7 +227,7 @@ (define (->alist drv)
(description . "Stand-alone binary Guix tarball")
(long-description . "This is a tarball containing binaries of Guix and
all its dependencies, and ready to be installed on non-GuixSD distributions.")
(license . ,gpl3+)
(license . ,(license-name gpl3+))
(home-page . ,%guix-home-page-url)
(maintainers . ("bug-guix@gnu.org"))))

3
guix/self.scm
View file

@ -624,7 +624,8 @@ (define *system-modules*
(define *cli-modules*
(scheme-node "guix-cli"
(scheme-modules* source "/guix/scripts")
(append (scheme-modules* source "/guix/scripts")
`((gnu ci)))
(list *core-modules* *extra-modules*
*core-package-modules* *package-modules*
*system-modules*)