diff options
Diffstat (limited to 'build-aux')
| -rw-r--r-- | build-aux/build-self.scm | 460 | ||||
| -rw-r--r-- | build-aux/compile-as-derivation.scm | 53 | ||||
| -rw-r--r-- | build-aux/cuirass/gnu-system.scm | 28 | ||||
| -rw-r--r-- | build-aux/cuirass/guix-modular.scm | 6 | ||||
| -rw-r--r-- | build-aux/cuirass/hydra-to-cuirass.scm | 47 | ||||
| -rw-r--r-- | build-aux/hydra/evaluate.scm | 11 | ||||
| -rw-r--r-- | build-aux/hydra/gnu-system.scm | 11 | ||||
| -rw-r--r-- | build-aux/hydra/guix-modular.scm | 54 | ||||
| -rw-r--r-- | build-aux/hydra/guix.scm | 4 |
9 files changed, 382 insertions, 292 deletions
diff --git a/build-aux/build-self.scm b/build-aux/build-self.scm index 4c85c09df6..bccb7a959e 100644 --- a/build-aux/build-self.scm +++ b/build-aux/build-self.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2014, 2016, 2017 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2014, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -19,10 +19,14 @@ (define-module (build-self) #:use-module (gnu) #:use-module (guix) + #:use-module (guix ui) #:use-module (guix config) + #:use-module (guix modules) #:use-module (srfi srfi-1) #:use-module (srfi srfi-19) + #:use-module (rnrs io ports) #:use-module (ice-9 match) + #:use-module (ice-9 popen) #:export (build)) ;;; Commentary: @@ -40,242 +44,256 @@ ;;; Code: -;; The dependencies. Don't refer explicitly to the variables because they -;; could be renamed or shuffled around in modules over time. Conversely, -;; 'find-best-packages-by-name' is expected to always have the same semantics. - -(define guix - (first (find-best-packages-by-name "guix" #f))) - -(define libgcrypt - (first (find-best-packages-by-name "libgcrypt" #f))) - -(define zlib - (first (find-best-packages-by-name "zlib" #f))) - -(define gzip - (first (find-best-packages-by-name "gzip" #f))) - -(define bzip2 - (first (find-best-packages-by-name "bzip2" #f))) - -(define xz - (first (find-best-packages-by-name "xz" #f))) - -(define (false-if-wrong-guile package) - "Return #f if PACKAGE depends on the \"wrong\" major version of Guile (e.g., -2.0 instead of 2.2), otherwise return PACKAGE." - (let ((guile (any (match-lambda - ((label (? package? dep) _ ...) - (and (string=? (package-name dep) "guile") - dep))) - (package-direct-inputs package)))) - (and (or (not guile) - (string-prefix? (effective-version) - (package-version guile))) - package))) - -(define (package-for-current-guile . names) - "Return the package with one of the given NAMES that depends on the current -Guile major version (2.0 or 2.2), or #f if none of the packages matches." - (let loop ((names names)) - (match names - (() - #f) - ((name rest ...) - (match (find-best-packages-by-name name #f) - (() - (loop rest)) - ((first _ ...) - (or (false-if-wrong-guile first) - (loop rest)))))))) - -(define guile-json - (package-for-current-guile "guile-json" - "guile2.2-json" - "guile2.0-json")) - -(define guile-ssh - (package-for-current-guile "guile-ssh" - "guile2.2-ssh" - "guile2.0-ssh")) - -(define guile-git - (package-for-current-guile "guile-git" - "guile2.0-git")) - -(define guile-bytestructures - (package-for-current-guile "guile-bytestructures" - "guile2.0-bytestructures")) - -;; The actual build procedure. +;;; +;;; Generating (guix config). +;;; +;;; This is copied from (guix self) because we cannot assume (guix self) is +;;; available at this point. +;;; + +(define %dependency-variables + ;; (guix config) variables corresponding to dependencies. + '(%libgcrypt %libz %xz %gzip %bzip2 %nix-instantiate)) + +(define %persona-variables + ;; (guix config) variables that define Guix's persona. + '(%guix-package-name + %guix-version + %guix-bug-report-address + %guix-home-page-url)) + +(define %config-variables + ;; (guix config) variables corresponding to Guix configuration (storedir, + ;; localstatedir, etc.) + (sort (filter pair? + (module-map (lambda (name var) + (and (not (memq name %dependency-variables)) + (not (memq name %persona-variables)) + (cons name (variable-ref var)))) + (resolve-interface '(guix config)))) + (lambda (name+value1 name+value2) + (string<? (symbol->string (car name+value1)) + (symbol->string (car name+value2)))))) + +(define* (make-config.scm #:key libgcrypt zlib gzip xz bzip2 + (package-name "GNU Guix") + (package-version "0") + (bug-report-address "bug-guix@gnu.org") + (home-page-url "https://gnu.org/s/guix")) + + ;; Hack so that Geiser is not confused. + (define defmod 'define-module) + + (scheme-file "config.scm" + #~(begin + (#$defmod (guix config) + #:export (%guix-package-name + %guix-version + %guix-bug-report-address + %guix-home-page-url + %libgcrypt + %libz + %gzip + %bzip2 + %xz + %nix-instantiate)) + + ;; XXX: Work around <http://bugs.gnu.org/15602>. + (eval-when (expand load eval) + #$@(map (match-lambda + ((name . value) + #~(define-public #$name #$value))) + %config-variables) + + (define %guix-package-name #$package-name) + (define %guix-version #$package-version) + (define %guix-bug-report-address #$bug-report-address) + (define %guix-home-page-url #$home-page-url) + + (define %gzip + #+(and gzip (file-append gzip "/bin/gzip"))) + (define %bzip2 + #+(and bzip2 (file-append bzip2 "/bin/bzip2"))) + (define %xz + #+(and xz (file-append xz "/bin/xz"))) + + (define %libgcrypt + #+(and libgcrypt + (file-append libgcrypt "/lib/libgcrypt"))) + (define %libz + #+(and zlib + (file-append zlib "/lib/libz"))) + + (define %nix-instantiate ;for (guix import snix) + "nix-instantiate"))))) -(define (top-source-directory) - "Return the name of the top-level directory of this source tree." - (and=> (assoc-ref (current-source-location) 'filename) - (lambda (file) - (string-append (dirname file) "/..")))) + +;;; +;;; 'gexp->script'. +;;; +;;; This is our own variant of 'gexp->script' with an extra #:module-path +;;; parameter, which was unavailable in (guix gexp) until commit +;;; 1ae16033f34cebe802023922436883867010850f (March 2018.) +;;; +(define (load-path-expression modules path) + "Return as a monadic value a gexp that sets '%load-path' and +'%load-compiled-path' to point to MODULES, a list of module names. MODULES +are searched for in PATH." + (mlet %store-monad ((modules (imported-modules modules + #:module-path path)) + (compiled (compiled-modules modules + #:module-path path))) + (return (gexp (eval-when (expand load eval) + (set! %load-path + (cons (ungexp modules) %load-path)) + (set! %load-compiled-path + (cons (ungexp compiled) + %load-compiled-path))))))) + +(define* (gexp->script name exp + #:key (guile (default-guile)) + (module-path %load-path)) + "Return an executable script NAME that runs EXP using GUILE, with EXP's +imported modules in its search path." + (mlet %store-monad ((set-load-path + (load-path-expression (gexp-modules exp) + module-path))) + (gexp->derivation name + (gexp + (call-with-output-file (ungexp output) + (lambda (port) + ;; Note: that makes a long shebang. When the store + ;; is /gnu/store, that fits within the 128-byte + ;; limit imposed by Linux, but that may go beyond + ;; when running tests. + (format port + "#!~a/bin/guile --no-auto-compile~%!#~%" + (ungexp guile)) + + (write '(ungexp set-load-path) port) + (write '(ungexp exp) port) + (chmod port #o555)))) + #:module-path module-path))) + (define (date-version-string) "Return the current date and hour in UTC timezone, for use as a poor person's version identifier." ;; XXX: Replace with a Git commit id. (date->string (current-date 0) "~Y~m~d.~H")) -(define (matching-guile-2.2) - "Return a Guile 2.2 with the same version as the current one or immediately -older than then current one. This is so that we do not build ABI-incompatible -objects. See <https://bugs.gnu.org/29570>." - (let loop ((packages (find-packages-by-name "guile" "2.2")) - (best #f)) - (match packages - (() - best) - ((head tail ...) - (if (string=? (package-version head) (version)) - head - (if best - (if (version>? (package-version head) (version)) - (loop tail best) - (loop tail head)) - (loop tail head))))))) - -(define (guile-for-build) - "Return a derivation for Guile 2.0 or 2.2, whichever matches the currently -running Guile." - (package->derivation (cond-expand - (guile-2.2 - (canonical-package (matching-guile-2.2))) - (else - (canonical-package - (specification->package "guile@2.0")))))) +(define* (build-program source version + #:optional (guile-version (effective-version))) + "Return a program that computes the derivation to build Guix from SOURCE." + (define select? + ;; Select every module but (guix config) and non-Guix modules. + (match-lambda + (('guix 'config) #f) + (('guix _ ...) #t) + (('gnu _ ...) #t) + (_ #f))) + + (with-imported-modules `(((guix config) + => ,(make-config.scm + #:libgcrypt + (specification->package "libgcrypt"))) + ,@(source-module-closure `((guix store) + (guix self) + (guix derivations) + (gnu packages bootstrap)) + (list source) + #:select? select?)) + (gexp->script "compute-guix-derivation" + #~(begin + (use-modules (ice-9 match)) + + (eval-when (expand load eval) + ;; Don't augment '%load-path'. + (unsetenv "GUIX_PACKAGE_PATH") + + ;; (gnu packages …) modules are going to be looked up + ;; under SOURCE. (guix config) is looked up in FRONT. + (match %load-path + ((#$source _ ...) + #t) ;already done + ((front _ ...) + (set! %load-path (list #$source front)))) + + ;; Only load our own modules or those of Guile. + (match %load-compiled-path + ((front _ ... sys1 sys2) + (set! %load-compiled-path + (list front sys1 sys2))))) + + (use-modules (guix store) + (guix self) + (guix derivations) + (srfi srfi-1)) + + (define (spin system) + (define spin + (circular-list "-" "\\" "|" "/" "-" "\\" "|" "/")) + + (format (current-error-port) + "Computing Guix derivation for '~a'... " + system) + (let loop ((spin spin)) + (display (string-append "\b" (car spin)) + (current-error-port)) + (force-output (current-error-port)) + (sleep 1) + (loop (cdr spin)))) + + (match (command-line) + ((_ _ system) + (with-store store + (call-with-new-thread + (lambda () + (spin system))) + + (display + (derivation-file-name + (run-with-store store + (guix-derivation #$source #$version + #$guile-version) + #:system system))))))) + #:module-path (list source)))) ;; The procedure below is our return value. (define* (build source - #:key verbose? (version (date-version-string)) + #:key verbose? (version (date-version-string)) system + (guile-version (match ((@ (guile) version)) + ("2.2.2" "2.2.2") + (_ (effective-version)))) #:allow-other-keys #:rest rest) "Return a derivation that unpacks SOURCE into STORE and compiles Scheme files." - ;; The '%xxxdir' variables were added to (guix config) in July 2016 so we - ;; cannot assume that they are defined. Try to guess their value when - ;; they're undefined (XXX: we get an incorrect guess when environment - ;; variables such as 'NIX_STATE_DIR' are defined!). - (define storedir - (if (defined? '%storedir) %storedir %store-directory)) - (define localstatedir - (if (defined? '%localstatedir) %localstatedir (dirname %state-directory))) - (define sysconfdir - (if (defined? '%sysconfdir) %sysconfdir (dirname %config-directory))) - - (define builder - #~(begin - (use-modules (guix build pull)) - - (letrec-syntax ((maybe-load-path - (syntax-rules () - ((_ item rest ...) - (let ((tail (maybe-load-path rest ...))) - (if (string? item) - (cons (string-append item - "/share/guile/site/" - #$(effective-version)) - tail) - tail))) - ((_) - '())))) - (set! %load-path - (append - (maybe-load-path #$guile-json #$guile-ssh - #$guile-git #$guile-bytestructures) - %load-path))) - - (letrec-syntax ((maybe-load-compiled-path - (syntax-rules () - ((_ item rest ...) - (let ((tail (maybe-load-compiled-path rest ...))) - (if (string? item) - (cons (string-append item - "/lib/guile/" - #$(effective-version) - "/site-ccache") - tail) - tail))) - ((_) - '())))) - (set! %load-compiled-path - (append - (maybe-load-compiled-path #$guile-json #$guile-ssh - #$guile-git #$guile-bytestructures) - %load-compiled-path))) - - ;; XXX: The 'guile-ssh' package prior to Guix commit 92b7258 was - ;; broken: libguile-ssh could not be found. Work around that. - ;; FIXME: We want Guile-SSH 0.10.2 or later anyway. - #$(if (string-prefix? "0.9." (package-version guile-ssh)) - #~(setenv "LTDL_LIBRARY_PATH" (string-append #$guile-ssh "/lib")) - #t) - - (build-guix #$output #$source - - #:system #$%system - #:storedir #$storedir - #:localstatedir #$localstatedir - #:sysconfdir #$sysconfdir - #:sbindir (string-append #$guix "/sbin") - - #:package-name #$%guix-package-name - #:package-version #$version - #:bug-report-address #$%guix-bug-report-address - #:home-page-url #$%guix-home-page-url - - #:libgcrypt #$libgcrypt - #:zlib #$zlib - #:gzip #$gzip - #:bzip2 #$bzip2 - #:xz #$xz - - ;; XXX: This is not perfect, enabling VERBOSE? means - ;; building a different derivation. - #:debug-port (if #$verbose? - (current-error-port) - (%make-void-port "w"))))) - - (unless guile-git - ;; XXX: Guix before February 2017 lacks a 'guile-git' package altogether. - ;; If we try to upgrade anyway, the logic in (guix scripts pull) will not - ;; build (guix git), which will leave us with an unusable 'guix pull'. To - ;; avoid that, fail early. - (format (current-error-port) - "\ -Your installation is too old and lacks a '~a' package. -Please upgrade to an intermediate version first, for instance with: - - guix pull --url=https://git.savannah.gnu.org/cgit/guix.git/snapshot/v0.13.0.tar.gz -\n" - (match (effective-version) - ("2.0" "guile2.0-git") - (_ "guile-git"))) - (exit 1)) - - (mlet %store-monad ((guile (guile-for-build))) - (gexp->derivation "guix-latest" builder - #:modules '((guix build pull) - (guix build utils) - (guix build compile) - - ;; Closure of (guix modules). - (guix modules) - (guix memoization) - (guix profiling) - (guix sets)) - - ;; Arrange so that our own (guix build …) modules are - ;; used. - #:module-path (list (top-source-directory)) - - #:guile-for-build guile))) + ;; Build the build program and then use it as a trampoline to build from + ;; SOURCE. + (mlet %store-monad ((build (build-program source version guile-version)) + (system (if system (return system) (current-system)))) + (mbegin %store-monad + (show-what-to-build* (list build)) + (built-derivations (list build)) + (let* ((pipe (begin + (setenv "GUILE_WARN_DEPRECATED" "no") ;be quiet and drive + (open-pipe* OPEN_READ + (derivation->output-path build) + source system))) + (str (get-string-all pipe)) + (status (close-pipe pipe))) + (match str + ((? eof-object?) + (error "build program failed" (list build status))) + ((? derivation-path? drv) + (mbegin %store-monad + (return (newline (current-output-port))) + ((store-lift add-temp-root) drv) + (return (read-derivation-from-file drv)))) + ((? string? str) + (error "invalid build result" (list build str)))))))) ;; This file is loaded by 'guix pull'; return it the build procedure. build diff --git a/build-aux/compile-as-derivation.scm b/build-aux/compile-as-derivation.scm new file mode 100644 index 0000000000..afb134a92a --- /dev/null +++ b/build-aux/compile-as-derivation.scm @@ -0,0 +1,53 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2018 Ludovic Courtès <ludo@gnu.org> +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; GNU Guix is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. + +;; Build Guix using Guix. + +(use-modules (srfi srfi-26)) + +;; Add ~/.config/guix/latest to the search path. +(add-to-load-path + (and=> (or (getenv "XDG_CONFIG_HOME") + (and=> (getenv "HOME") + (cut string-append <> "/.config"))) + (cut string-append <> "/guix/latest"))) + +(use-modules (guix) (guix ui) + (guix git-download) + (ice-9 match)) + +(match (command-line) + ((program source) + (with-error-handling + (with-store store + (let* ((script (string-append source "/build-aux/build-self.scm")) + (build (primitive-load script)) + (git? (git-predicate source))) + (run-with-store store + ;; TODO: Extract #:version and #:commit using Guile-Git. + (mlet* %store-monad ((source (interned-file source "guix-source" + #:select? git? + #:recursive? #t)) + (drv (build source))) + (mbegin %store-monad + (show-what-to-build* (list drv)) + (built-derivations (list drv)) + (with-monad %store-monad + (display (derivation->output-path drv)) + (newline) + (return drv)))))))))) diff --git a/build-aux/cuirass/gnu-system.scm b/build-aux/cuirass/gnu-system.scm index f545ba03bc..0eb834cfba 100644 --- a/build-aux/cuirass/gnu-system.scm +++ b/build-aux/cuirass/gnu-system.scm @@ -21,29 +21,5 @@ ;;; tool. ;;; -(include-from-path "build-aux/hydra/gnu-system.scm") - -(use-modules ((guix licenses) - #:select (license? license-name license-uri license-comment))) - -(define (cuirass-jobs store arguments) - "Return Cuirass jobs." - (map hydra-job->cuirass-job (hydra-jobs store arguments))) - -(define (hydra-job->cuirass-job hydra-job) - (let ((name (car hydra-job)) - (job ((cdr hydra-job)))) - (lambda _ (acons #:job-name (symbol->string name) - (map symbol-alist-entry->keyword-alist-entry job))))) - -(define (symbol-alist-entry->keyword-alist-entry entry) - (cons (symbol->keyword (car entry)) (entry->sexp-entry (cdr entry)))) - -(define (entry->sexp-entry o) - (match o - ((? license?) `((name . (license-name o)) - (uri . ,(license-uri o)) - (comment . ,(license-comment o)))) - ((lst ...) - (map entry->sexp-entry lst)) - (_ o))) +(include "../hydra/gnu-system.scm") +(include "hydra-to-cuirass.scm") diff --git a/build-aux/cuirass/guix-modular.scm b/build-aux/cuirass/guix-modular.scm new file mode 100644 index 0000000000..cbbdbf1133 --- /dev/null +++ b/build-aux/cuirass/guix-modular.scm @@ -0,0 +1,6 @@ +;;; +;;; This file defines Cuirass build jobs to build Guix itself. +;;; + +(include "../hydra/guix-modular.scm") +(include "hydra-to-cuirass.scm") diff --git a/build-aux/cuirass/hydra-to-cuirass.scm b/build-aux/cuirass/hydra-to-cuirass.scm new file mode 100644 index 0000000000..75c77ea35a --- /dev/null +++ b/build-aux/cuirass/hydra-to-cuirass.scm @@ -0,0 +1,47 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2017 Jan Nieuwenhuizen <janneke@gnu.org> +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; GNU Guix is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. + +;;; +;;; This file defines the conversion of Hydra build jobs to Cuirass build +;;; jobs. It is meant to be included in other files. +;;; + +(use-modules ((guix licenses) + #:select (license? license-name license-uri license-comment))) + +(define (cuirass-jobs store arguments) + "Return Cuirass jobs." + (map hydra-job->cuirass-job (hydra-jobs store arguments))) + +(define (hydra-job->cuirass-job hydra-job) + (let ((name (car hydra-job)) + (job ((cdr hydra-job)))) + (lambda _ (acons #:job-name (symbol->string name) + (map symbol-alist-entry->keyword-alist-entry job))))) + +(define (symbol-alist-entry->keyword-alist-entry entry) + (cons (symbol->keyword (car entry)) (entry->sexp-entry (cdr entry)))) + +(define (entry->sexp-entry o) + (match o + ((? license?) `((name . (license-name o)) + (uri . ,(license-uri o)) + (comment . ,(license-comment o)))) + ((lst ...) + (map entry->sexp-entry lst)) + (_ o))) diff --git a/build-aux/hydra/evaluate.scm b/build-aux/hydra/evaluate.scm index 8e391f44fd..5793c022ff 100644 --- a/build-aux/hydra/evaluate.scm +++ b/build-aux/hydra/evaluate.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2016, 2017 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2017 Jan Nieuwenhuizen <janneke@gnu.org> ;;; ;;; This file is part of GNU Guix. @@ -79,7 +79,8 @@ Otherwise return THING." (match (command-line) ((command file cuirass? ...) ;; Load FILE, a Scheme file that defines Hydra jobs. - (let ((port (current-output-port))) + (let ((port (current-output-port)) + (real-build-things build-things)) (save-module-excursion (lambda () (set-current-module %user-module) @@ -93,13 +94,15 @@ Otherwise return THING." ;; Grafts can trigger early builds. We do not want that to happen ;; during evaluation, so use a sledgehammer to catch such problems. + ;; An exception, though, is the evaluation of Guix itself, which + ;; requires building a "trampoline" program. (set! build-things (lambda (store . args) (format (current-error-port) - "error: trying to build things during evaluation!~%") + "warning: building things during evaluation~%") (format (current-error-port) "'build-things' arguments: ~s~%" args) - (exit 1))) + (apply real-build-things store args))) ;; Call the entry point of FILE and print the resulting job sexp. (pretty-print diff --git a/build-aux/hydra/gnu-system.scm b/build-aux/hydra/gnu-system.scm index 8178871747..62eb957f83 100644 --- a/build-aux/hydra/gnu-system.scm +++ b/build-aux/hydra/gnu-system.scm @@ -24,7 +24,7 @@ (use-modules (system base compile)) -(eval-when (compile load eval) +(eval-when (expand load eval) ;; Pre-load the compiler so we don't end up auto-compiling it. (compile #t) @@ -32,6 +32,15 @@ ;; 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 (string-append (dirname file) "/../.."))) diff --git a/build-aux/hydra/guix-modular.scm b/build-aux/hydra/guix-modular.scm index bdbb2fa8d5..58e09e1831 100644 --- a/build-aux/hydra/guix-modular.scm +++ b/build-aux/hydra/guix-modular.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2017 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2017, 2018 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -21,35 +21,14 @@ ;;; Guix as 'guix pull', which is defined in (guix self). ;;; -;; Attempt to use our very own Guix modules. -(eval-when (compile load eval) - - ;; Ignore any available .go, and force recompilation. 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. - (set! %fresh-auto-compile #t) - - (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 (guix store) (guix config) (guix utils) - (guix grafts) ((guix packages) #:select (%hydra-supported-systems)) (guix derivations) (guix monads) - (guix gexp) - (guix self) ((guix licenses) #:prefix license:) (srfi srfi-1) - (srfi srfi-26) (ice-9 match)) ;; XXX: Debugging hack: since `hydra-eval-guile-jobs' redirects the output @@ -61,11 +40,13 @@ "Return a Hydra job a list building the modular Guix derivation from SOURCE for SYSTEM. Use VERSION as the version identifier." (lambda () + (define build + (primitive-load (string-append source "/build-aux/build-self.scm"))) + `((derivation . ,(derivation-file-name - (parameterize ((%graft? #f)) - (run-with-store store - (lower-object (compiled-guix source - #:version version)))))) + (run-with-store store + (build source #:version version #:system system + #:guile-version "2.2")))) ;the latest 2.2.x (description . "Modular Guix") (long-description . "This is the modular Guix package as produced by 'guix pull'.") @@ -76,29 +57,26 @@ for SYSTEM. Use VERSION as the version identifier." (define (hydra-jobs store arguments) "Return Hydra jobs." (define systems - (match (filter-map (match-lambda - (('system . value) value) - (_ #f)) - arguments) - ((lst ..1) - lst) - (_ - (list (%current-system))))) + (match (assoc-ref arguments 'systems) + (#f %hydra-supported-systems) + ((lst ...) lst) + ((? string? str) (call-with-input-string str read)))) (define guix-checkout - (assq-ref arguments 'guix)) + (or (assq-ref arguments 'guix) ;Hydra on hydra + (assq-ref arguments 'guix-modular))) ;Cuirass on berlin (define version (or (assq-ref guix-checkout 'revision) "0.unknown")) (let ((file (assq-ref guix-checkout 'file-name))) - (format (current-error-port) "using checkout ~s (~s)~%" - guix-checkout file) + (format (current-error-port) "using checkout ~s (~s; arguments: ~s)~%" + guix-checkout file arguments) (map (lambda (system) (let ((name (string->symbol (string-append "guix." system)))) `(,name . ,(build-job store file version system)))) - %hydra-supported-systems))) + systems))) diff --git a/build-aux/hydra/guix.scm b/build-aux/hydra/guix.scm index 659b8bfbc1..08193ec82e 100644 --- a/build-aux/hydra/guix.scm +++ b/build-aux/hydra/guix.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -22,7 +22,7 @@ ;;; ;; Attempt to use our very own Guix modules. -(eval-when (compile load eval) +(eval-when (expand load eval) ;; Ignore any available .go, and force recompilation. This is because our ;; checkout in the store has mtime set to the epoch, and thus .go files look |