GNU bug report logs - #33515
[PATCH 0/5] Cuirass/Hydra: evaluate jobs in an inferior

Please note: This is a static page, with minimal formatting, updated once a day.
Click here to see this page with the latest information and nicer formatting.

Package: guix-patches; Reported by: Ludovic Courtès <ludo@HIDDEN>; Keywords: patch; dated Mon, 26 Nov 2018 16:39:02 UTC; Maintainer for guix-patches is guix-patches@HIDDEN.

Message received at 33515 <at> debbugs.gnu.org:


Received: (at 33515) by debbugs.gnu.org; 26 Nov 2018 16:45:56 +0000
From debbugs-submit-bounces <at> debbugs.gnu.org Mon Nov 26 11:45:56 2018
Received: from localhost ([127.0.0.1]:50053 helo=debbugs.gnu.org)
	by debbugs.gnu.org with esmtp (Exim 4.84_2)
	(envelope-from <debbugs-submit-bounces <at> debbugs.gnu.org>)
	id 1gRK1C-0002SZ-IM
	for submit <at> debbugs.gnu.org; Mon, 26 Nov 2018 11:45:56 -0500
Received: from eggs.gnu.org ([208.118.235.92]:60935)
 by debbugs.gnu.org with esmtp (Exim 4.84_2)
 (envelope-from <ludo@HIDDEN>) id 1gRK16-0002I8-8D
 for 33515 <at> debbugs.gnu.org; Mon, 26 Nov 2018 11:45:50 -0500
Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71)
 (envelope-from <ludo@HIDDEN>) id 1gRK0y-000774-CS
 for 33515 <at> debbugs.gnu.org; Mon, 26 Nov 2018 11:45:43 -0500
X-Spam-Checker-Version: SpamAssassin 3.3.2 (2011-06-06) on eggs.gnu.org
X-Spam-Level: 
X-Spam-Status: No, score=0.8 required=5.0 tests=BAYES_50 autolearn=disabled
 version=3.3.2
Received: from fencepost.gnu.org ([2001:4830:134:3::e]:51259)
 by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from <ludo@HIDDEN>)
 id 1gRK0u-00074O-4a; Mon, 26 Nov 2018 11:45:36 -0500
Received: from [2001:660:6102:320:e120:2c8f:8909:cdfe] (port=51762
 helo=gnu.org)
 by fencepost.gnu.org with esmtpsa (TLS1.2:DHE_RSA_AES_256_CBC_SHA1:256)
 (Exim 4.82) (envelope-from <ludo@HIDDEN>)
 id 1gRK0t-00051o-IM; Mon, 26 Nov 2018 11:45:36 -0500
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@HIDDEN>
To: 33515 <at> debbugs.gnu.org
Subject: [PATCH 2/5] hydra: Move job definitions to (gnu ci).
Date: Mon, 26 Nov 2018 17:45:21 +0100
Message-Id: <20181126164524.17680-2-ludo@HIDDEN>
X-Mailer: git-send-email 2.19.1
In-Reply-To: <20181126164524.17680-1-ludo@HIDDEN>
References: <20181126164524.17680-1-ludo@HIDDEN>
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic]
X-Received-From: 2001:4830:134:3::e
X-Spam-Score: -5.0 (-----)
X-Debbugs-Envelope-To: 33515
Cc: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@HIDDEN>
X-BeenThere: debbugs-submit <at> debbugs.gnu.org
X-Mailman-Version: 2.1.18
Precedence: list
List-Id: <debbugs-submit.debbugs.gnu.org>
List-Unsubscribe: <https://debbugs.gnu.org/cgi-bin/mailman/options/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=unsubscribe>
List-Archive: <https://debbugs.gnu.org/cgi-bin/mailman/private/debbugs-submit/>
List-Post: <mailto:debbugs-submit <at> debbugs.gnu.org>
List-Help: <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=help>
List-Subscribe: <https://debbugs.gnu.org/cgi-bin/mailman/listinfo/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=subscribe>
Errors-To: debbugs-submit-bounces <at> debbugs.gnu.org
Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
X-Spam-Score: -6.0 (------)

* build-aux/hydra/gnu-system.scm: Move code to...
* gnu/ci.scm: ... here.  New file.
* gnu/local.mk (GNU_SYSTEM_MODULES): Add it.
---
 build-aux/hydra/gnu-system.scm | 403 +-----------------------------
 gnu/ci.scm                     | 430 +++++++++++++++++++++++++++++++++
 gnu/local.mk                   |   4 +-
 3 files changed, 436 insertions(+), 401 deletions(-)
 create mode 100644 gnu/ci.scm

diff --git a/build-aux/hydra/gnu-system.scm b/build-aux/hydra/gnu-system.scm
index d6b0132807..150c2bdf4f 100644
--- a/build-aux/hydra/gnu-system.scm
+++ b/build-aux/hydra/gnu-system.scm
@@ -50,409 +50,12 @@
                      dir)
              (set! %load-path (cons dir %load-path))))))
 
-(use-modules (guix config)
-             (guix store)
-             (guix grafts)
-             (guix profiles)
-             (guix packages)
-             (guix derivations)
-             (guix monads)
-             (guix ui)
-             ((guix licenses) #:select (gpl3+))
-             ((guix utils) #:select (%current-system))
-             ((guix scripts system) #:select (read-operating-system))
-             ((guix scripts pack)
-              #:select (lookup-compressor self-contained-tarball))
-             (gnu bootloader)
-             (gnu bootloader u-boot)
-             (gnu packages)
-             (gnu packages gcc)
-             (gnu packages base)
-             (gnu packages gawk)
-             (gnu packages guile)
-             (gnu packages gettext)
-             (gnu packages compression)
-             (gnu packages multiprecision)
-             (gnu packages make-bootstrap)
-             (gnu packages package-management)
-             (gnu system)
-             (gnu system vm)
-             (gnu system install)
-             (gnu tests)
-             (srfi srfi-1)
-             (srfi srfi-26)
-             (ice-9 match))
+(use-modules (gnu ci))
 
 ;; 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))
 
-(define* (package->alist store package system
-                         #:optional (package-derivation package-derivation))
-  "Convert PACKAGE to an alist suitable for Hydra."
-  (parameterize ((%graft? #f))
-    `((derivation . ,(derivation-file-name
-                      (package-derivation store package system
-                                          #:graft? #f)))
-      (description . ,(package-synopsis package))
-      (long-description . ,(package-description package))
-      (license . ,(package-license package))
-      (home-page . ,(package-home-page package))
-      (maintainers . ("bug-guix@HIDDEN"))
-      (max-silent-time . ,(or (assoc-ref (package-properties package)
-                                         'max-silent-time)
-                              3600))              ;1 hour by default
-      (timeout . ,(or (assoc-ref (package-properties package) 'timeout)
-                      72000)))))                  ;20 hours by default
-
-(define (package-job store job-name package system)
-  "Return a job called JOB-NAME that builds PACKAGE on SYSTEM."
-  (let ((job-name (symbol-append job-name (string->symbol ".")
-                                 (string->symbol system))))
-    `(,job-name . ,(cut package->alist store package system))))
-
-(define (package-cross-job store job-name package target system)
-  "Return a job called TARGET.JOB-NAME that cross-builds PACKAGE for TARGET on
-SYSTEM."
-  `(,(symbol-append (string->symbol target) (string->symbol ".") job-name
-                    (string->symbol ".") (string->symbol system)) .
-    ,(cute package->alist store package system
-           (lambda* (store package system #:key graft?)
-             (package-cross-derivation store package target system
-                                       #:graft? graft?)))))
-
-(define %core-packages
-  ;; Note: Don't put the '-final' package variants because (1) that's
-  ;; implicit, and (2) they cannot be cross-built (due to the explicit input
-  ;; chain.)
-  (list gcc-4.8 gcc-4.9 gcc-5 glibc binutils
-        gmp mpfr mpc coreutils findutils diffutils patch sed grep
-        gawk gnu-gettext hello guile-2.0 guile-2.2 zlib gzip xz
-        %bootstrap-binaries-tarball
-        %binutils-bootstrap-tarball
-        (%glibc-bootstrap-tarball)
-        %gcc-bootstrap-tarball
-        %guile-bootstrap-tarball
-        %bootstrap-tarballs))
-
-(define %packages-to-cross-build
-  %core-packages)
-
-(define %cross-targets
-  '("mips64el-linux-gnu"
-    "mips64el-linux-gnuabi64"
-    "arm-linux-gnueabihf"
-    "aarch64-linux-gnu"
-    "powerpc-linux-gnu"
-    "i586-pc-gnu"                                 ;aka. GNU/Hurd
-    "i686-w64-mingw32"))
-
-(define %guixsd-supported-systems
-  '("x86_64-linux" "i686-linux" "armhf-linux"))
-
-(define %u-boot-systems
-  '("armhf-linux"))
-
-(define (qemu-jobs store system)
-  "Return a list of jobs that build QEMU images for SYSTEM."
-  (define (->alist drv)
-    `((derivation . ,(derivation-file-name 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+)
-      (home-page . ,%guix-home-page-url)
-      (maintainers . ("bug-guix@HIDDEN"))))
-
-  (define (->job name drv)
-    (let ((name (symbol-append name (string->symbol ".")
-                               (string->symbol system))))
-      `(,name . ,(lambda ()
-                   (parameterize ((%graft? #f))
-                     (->alist drv))))))
-
-  (define MiB
-    (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
-                            (* 1024 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
-                                              (* 1024 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"))))))
-      '()))
-
-(define (system-test-jobs store system)
-  "Return a list of jobs for the system tests."
-  (define (test->thunk test)
-    (lambda ()
-      (define drv
-        (run-with-store store
-          (mbegin %store-monad
-            (set-current-system system)
-            (set-grafting #f)
-            (set-guile-for-build (default-guile))
-            (system-test-value test))))
-
-      `((derivation . ,(derivation-file-name drv))
-        (description . ,(format #f "GuixSD '~a' system test"
-                                (system-test-name test)))
-        (long-description . ,(system-test-description test))
-        (license . ,gpl3+)
-        (home-page . ,%guix-home-page-url)
-        (maintainers . ("bug-guix@HIDDEN")))))
-
-  (define (->job test)
-    (let ((name (string->symbol
-                 (string-append "test." (system-test-name test)
-                                "." system))))
-      (cons name (test->thunk test))))
-
-  (if (member system %guixsd-supported-systems)
-      (map ->job (all-system-tests))
-      '()))
-
-(define (tarball-jobs store system)
-  "Return Hydra jobs to build the self-contained Guix binary tarball."
-  (define (->alist drv)
-    `((derivation . ,(derivation-file-name 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+)
-      (home-page . ,%guix-home-page-url)
-      (maintainers . ("bug-guix@HIDDEN"))))
-
-  (define (->job name drv)
-    (let ((name (symbol-append name (string->symbol ".")
-                               (string->symbol system))))
-      `(,name . ,(lambda ()
-                   (parameterize ((%graft? #f))
-                     (->alist drv))))))
-
-  ;; XXX: Add a job for the stable Guix?
-  (list (->job 'binary-tarball
-               (run-with-store store
-                 (mbegin %store-monad
-                   (set-guile-for-build (default-guile))
-                   (>>= (profile-derivation (packages->manifest (list guix)))
-                        (lambda (profile)
-                          (self-contained-tarball "guix-binary" profile
-                                                  #:localstatedir? #t
-                                                  #:compressor
-                                                  (lookup-compressor "xz")))))
-                 #:system system))))
-
-(define job-name
-  ;; Return the name of a package's job.
-  (compose string->symbol
-           (cut package-full-name <> "-")))
-
-(define package->job
-  (let ((base-packages
-         (delete-duplicates
-          (append-map (match-lambda
-                       ((_ package _ ...)
-                        (match (package-transitive-inputs package)
-                          (((_ inputs _ ...) ...)
-                           inputs))))
-                      (%final-inputs)))))
-    (lambda (store package system)
-      "Return a job for PACKAGE on SYSTEM, or #f if this combination is not
-valid."
-      (cond ((member package base-packages)
-             (package-job store (symbol-append 'base. (job-name package))
-                          package system))
-            ((supported-package? package system)
-             (let ((drv (package-derivation store package system
-                                            #:graft? #f)))
-               (and (substitutable-derivation? drv)
-                    (package-job store (job-name package)
-                                 package system))))
-            (else
-             #f)))))
-
-(define (all-packages)
-  "Return the list of packages to build."
-  (define (adjust package result)
-    (cond ((package-replacement package)
-           (cons* package                         ;build both
-                  (package-replacement package)
-                  result))
-          ((package-superseded package)
-           result)                                ;don't build it
-          (else
-           (cons package result))))
-
-  (fold-packages adjust
-                 (fold adjust '()                 ;include base packages
-                       (match (%final-inputs)
-                         (((labels packages _ ...) ...)
-                          packages)))
-                 #:select? (const #t)))           ;include hidden packages
-
-(define (arguments->manifests arguments)
-  "Return the list of manifests extracted from ARGUMENTS."
-  (map (match-lambda
-         ((input-name . relative-path)
-          (let* ((checkout (assq-ref arguments (string->symbol input-name)))
-                 (base (assq-ref checkout 'file-name)))
-            (in-vicinity base relative-path))))
-       (assq-ref arguments 'manifests)))
-
-(define (manifests->packages store manifests)
-  "Return the list of packages found in MANIFESTS."
-  (define (load-manifest manifest)
-    (save-module-excursion
-     (lambda ()
-       (set-current-module (make-user-module '((guix profiles) (gnu))))
-       (primitive-load manifest))))
-
-  (delete-duplicates!
-   (map manifest-entry-item
-        (append-map (compose manifest-entries
-                             load-manifest)
-                    manifests))))
-
-
-;;;
-;;; Hydra entry point.
-;;;
-
-(define (hydra-jobs store arguments)
-  "Return Hydra jobs."
-  (define subset
-    (match (assoc-ref arguments 'subset)
-      ("core" 'core)                              ; only build core packages
-      ("hello" 'hello)                            ; only build hello
-      (((? string?) (? string?) ...) 'list)       ; only build selected list of packages
-      ("manifests" 'manifests)                    ; only build packages in the list of manifests
-      (_ 'all)))                                  ; build everything
-
-  (define systems
-    (match (assoc-ref arguments 'systems)
-      (#f              %hydra-supported-systems)
-      ((lst ...)       lst)
-      ((? string? str) (call-with-input-string str read))))
-
-  (define (cross-jobs system)
-    (define (from-32-to-64? target)
-      ;; Return true if SYSTEM is 32-bit and TARGET is 64-bit.  This hack
-      ;; prevents known-to-fail cross-builds from i686-linux or armhf-linux to
-      ;; mips64el-linux-gnuabi64.
-      (and (or (string-prefix? "i686-" system)
-               (string-prefix? "i586-" system)
-               (string-prefix? "armhf-" system))
-           (string-contains target "64")))    ;x86_64, mips64el, aarch64, etc.
-
-    (define (same? target)
-      ;; Return true if SYSTEM and TARGET are the same thing.  This is so we
-      ;; don't try to cross-compile to 'mips64el-linux-gnu' from
-      ;; 'mips64el-linux'.
-      (or (string-contains target system)
-          (and (string-prefix? "armhf" system)    ;armhf-linux
-               (string-prefix? "arm" target))))   ;arm-linux-gnueabihf
-
-    (define (pointless? target)
-      ;; Return #t if it makes no sense to cross-build to TARGET from SYSTEM.
-      (match system
-        ((or "x86_64-linux" "i686-linux")
-         (if (string-contains target "mingw")
-             (not (string=? "x86_64-linux" system))
-             #f))
-        (_
-         ;; Don't try to cross-compile from non-Intel platforms: this isn't
-         ;; very useful and these are often brittle configurations.
-         #t)))
-
-    (define (either proc1 proc2 proc3)
-      (lambda (x)
-        (or (proc1 x) (proc2 x) (proc3 x))))
-
-    (append-map (lambda (target)
-                  (map (lambda (package)
-                         (package-cross-job store (job-name package)
-                                            package target system))
-                       %packages-to-cross-build))
-                (remove (either from-32-to-64? same? pointless?)
-                        %cross-targets)))
-
-  ;; Turn off grafts.  Grafting is meant to happen on the user's machines.
-  (parameterize ((%graft? #f))
-    ;; Return one job for each package, except bootstrap packages.
-    (append-map (lambda (system)
-                  (format (current-error-port)
-                          "evaluating for '~a' (heap size: ~a MiB)...~%"
-                          system
-                          (round
-                           (/ (assoc-ref (gc-stats) 'heap-size)
-                              (expt 2. 20))))
-                  (invalidate-derivation-caches!)
-                  (case subset
-                    ((all)
-                     ;; Build everything, including replacements.
-                     (let ((all (all-packages))
-                           (job (lambda (package)
-                                  (package->job store package
-                                                system))))
-                       (append (filter-map job all)
-                               (qemu-jobs store system)
-                               (system-test-jobs store system)
-                               (tarball-jobs store system)
-                               (cross-jobs system))))
-                    ((core)
-                     ;; Build core packages only.
-                     (append (map (lambda (package)
-                                    (package-job store (job-name package)
-                                                 package system))
-                                  %core-packages)
-                             (cross-jobs system)))
-                    ((hello)
-                     ;; Build hello package only.
-                     (if (string=? system (%current-system))
-                         (let ((hello (specification->package "hello")))
-                           (list (package-job store (job-name hello) hello system)))
-                         '()))
-                    ((list)
-                     ;; Build selected list of packages only.
-                     (if (string=? system (%current-system))
-                         (let* ((names (assoc-ref arguments 'subset))
-                                (packages (map specification->package names)))
-                           (map (lambda (package)
-                                    (package-job store (job-name package)
-                                                 package system))
-                                  packages))
-                         '()))
-                    ((manifests)
-                     ;; Build packages in the list of manifests.
-                     (let* ((manifests (arguments->manifests arguments))
-                            (packages (manifests->packages store manifests)))
-                       (map (lambda (package)
-                              (package-job store (job-name package)
-                                           package system))
-                            packages)))
-                    (else
-                     (error "unknown subset" subset))))
-                systems)))
+;; Return the procedure from (gnu ci).
+hydra-jobs
diff --git a/gnu/ci.scm b/gnu/ci.scm
new file mode 100644
index 0000000000..8ece08e453
--- /dev/null
+++ b/gnu/ci.scm
@@ -0,0 +1,430 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@HIDDEN>
+;;; Copyright © 2017 Jan Nieuwenhuizen <janneke@HIDDEN>
+;;; Copyright © 2018 Clément Lassieur <clement@HIDDEN>
+;;;
+;;; 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/>.
+
+(define-module (gnu ci)
+  #:use-module (guix config)
+  #:use-module (guix store)
+  #:use-module (guix grafts)
+  #:use-module (guix profiles)
+  #:use-module (guix packages)
+  #:use-module (guix derivations)
+  #:use-module (guix monads)
+  #:use-module (guix ui)
+  #:use-module ((guix licenses) #:select (gpl3+))
+  #:use-module ((guix utils) #:select (%current-system))
+  #:use-module ((guix scripts system) #:select (read-operating-system))
+  #:use-module ((guix scripts pack)
+                #:select (lookup-compressor self-contained-tarball))
+  #:use-module (gnu bootloader)
+  #:use-module (gnu bootloader u-boot)
+  #:use-module (gnu packages)
+  #:use-module (gnu packages gcc)
+  #:use-module (gnu packages base)
+  #:use-module (gnu packages gawk)
+  #:use-module (gnu packages guile)
+  #:use-module (gnu packages gettext)
+  #:use-module (gnu packages compression)
+  #:use-module (gnu packages multiprecision)
+  #:use-module (gnu packages make-bootstrap)
+  #:use-module (gnu packages package-management)
+  #:use-module (gnu system)
+  #: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 (hydra-jobs))
+
+;;; Commentary:
+;;;
+;;; This file defines build jobs for the Hydra and Cuirass continuation
+;;; integration tools.
+;;;
+;;; Code:
+
+(define* (package->alist store package system
+                         #:optional (package-derivation package-derivation))
+  "Convert PACKAGE to an alist suitable for Hydra."
+  (parameterize ((%graft? #f))
+    `((derivation . ,(derivation-file-name
+                      (package-derivation store package system
+                                          #:graft? #f)))
+      (description . ,(package-synopsis package))
+      (long-description . ,(package-description package))
+      (license . ,(package-license package))
+      (home-page . ,(package-home-page package))
+      (maintainers . ("bug-guix@HIDDEN"))
+      (max-silent-time . ,(or (assoc-ref (package-properties package)
+                                         'max-silent-time)
+                              3600))              ;1 hour by default
+      (timeout . ,(or (assoc-ref (package-properties package) 'timeout)
+                      72000)))))                  ;20 hours by default
+
+(define (package-job store job-name package system)
+  "Return a job called JOB-NAME that builds PACKAGE on SYSTEM."
+  (let ((job-name (symbol-append job-name (string->symbol ".")
+                                 (string->symbol system))))
+    `(,job-name . ,(cut package->alist store package system))))
+
+(define (package-cross-job store job-name package target system)
+  "Return a job called TARGET.JOB-NAME that cross-builds PACKAGE for TARGET on
+SYSTEM."
+  `(,(symbol-append (string->symbol target) (string->symbol ".") job-name
+                    (string->symbol ".") (string->symbol system)) .
+    ,(cute package->alist store package system
+           (lambda* (store package system #:key graft?)
+             (package-cross-derivation store package target system
+                                       #:graft? graft?)))))
+
+(define %core-packages
+  ;; Note: Don't put the '-final' package variants because (1) that's
+  ;; implicit, and (2) they cannot be cross-built (due to the explicit input
+  ;; chain.)
+  (list gcc-4.8 gcc-4.9 gcc-5 glibc binutils
+        gmp mpfr mpc coreutils findutils diffutils patch sed grep
+        gawk gnu-gettext hello guile-2.0 guile-2.2 zlib gzip xz
+        %bootstrap-binaries-tarball
+        %binutils-bootstrap-tarball
+        (%glibc-bootstrap-tarball)
+        %gcc-bootstrap-tarball
+        %guile-bootstrap-tarball
+        %bootstrap-tarballs))
+
+(define %packages-to-cross-build
+  %core-packages)
+
+(define %cross-targets
+  '("mips64el-linux-gnu"
+    "mips64el-linux-gnuabi64"
+    "arm-linux-gnueabihf"
+    "aarch64-linux-gnu"
+    "powerpc-linux-gnu"
+    "i586-pc-gnu"                                 ;aka. GNU/Hurd
+    "i686-w64-mingw32"))
+
+(define %guixsd-supported-systems
+  '("x86_64-linux" "i686-linux" "armhf-linux"))
+
+(define %u-boot-systems
+  '("armhf-linux"))
+
+(define (qemu-jobs store system)
+  "Return a list of jobs that build QEMU images for SYSTEM."
+  (define (->alist drv)
+    `((derivation . ,(derivation-file-name 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+)
+      (home-page . ,%guix-home-page-url)
+      (maintainers . ("bug-guix@HIDDEN"))))
+
+  (define (->job name drv)
+    (let ((name (symbol-append name (string->symbol ".")
+                               (string->symbol system))))
+      `(,name . ,(lambda ()
+                   (parameterize ((%graft? #f))
+                     (->alist drv))))))
+
+  (define MiB
+    (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
+                            (* 1024 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
+                                              (* 1024 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"))))))
+      '()))
+
+(define (system-test-jobs store system)
+  "Return a list of jobs for the system tests."
+  (define (test->thunk test)
+    (lambda ()
+      (define drv
+        (run-with-store store
+          (mbegin %store-monad
+            (set-current-system system)
+            (set-grafting #f)
+            (set-guile-for-build (default-guile))
+            (system-test-value test))))
+
+      `((derivation . ,(derivation-file-name drv))
+        (description . ,(format #f "GuixSD '~a' system test"
+                                (system-test-name test)))
+        (long-description . ,(system-test-description test))
+        (license . ,gpl3+)
+        (home-page . ,%guix-home-page-url)
+        (maintainers . ("bug-guix@HIDDEN")))))
+
+  (define (->job test)
+    (let ((name (string->symbol
+                 (string-append "test." (system-test-name test)
+                                "." system))))
+      (cons name (test->thunk test))))
+
+  (if (member system %guixsd-supported-systems)
+      (map ->job (all-system-tests))
+      '()))
+
+(define (tarball-jobs store system)
+  "Return Hydra jobs to build the self-contained Guix binary tarball."
+  (define (->alist drv)
+    `((derivation . ,(derivation-file-name 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+)
+      (home-page . ,%guix-home-page-url)
+      (maintainers . ("bug-guix@HIDDEN"))))
+
+  (define (->job name drv)
+    (let ((name (symbol-append name (string->symbol ".")
+                               (string->symbol system))))
+      `(,name . ,(lambda ()
+                   (parameterize ((%graft? #f))
+                     (->alist drv))))))
+
+  ;; XXX: Add a job for the stable Guix?
+  (list (->job 'binary-tarball
+               (run-with-store store
+                 (mbegin %store-monad
+                   (set-guile-for-build (default-guile))
+                   (>>= (profile-derivation (packages->manifest (list guix)))
+                        (lambda (profile)
+                          (self-contained-tarball "guix-binary" profile
+                                                  #:localstatedir? #t
+                                                  #:compressor
+                                                  (lookup-compressor "xz")))))
+                 #:system system))))
+
+(define job-name
+  ;; Return the name of a package's job.
+  (compose string->symbol
+           (cut package-full-name <> "-")))
+
+(define package->job
+  (let ((base-packages
+         (delete-duplicates
+          (append-map (match-lambda
+                       ((_ package _ ...)
+                        (match (package-transitive-inputs package)
+                          (((_ inputs _ ...) ...)
+                           inputs))))
+                      (%final-inputs)))))
+    (lambda (store package system)
+      "Return a job for PACKAGE on SYSTEM, or #f if this combination is not
+valid."
+      (cond ((member package base-packages)
+             (package-job store (symbol-append 'base. (job-name package))
+                          package system))
+            ((supported-package? package system)
+             (let ((drv (package-derivation store package system
+                                            #:graft? #f)))
+               (and (substitutable-derivation? drv)
+                    (package-job store (job-name package)
+                                 package system))))
+            (else
+             #f)))))
+
+(define (all-packages)
+  "Return the list of packages to build."
+  (define (adjust package result)
+    (cond ((package-replacement package)
+           (cons* package                         ;build both
+                  (package-replacement package)
+                  result))
+          ((package-superseded package)
+           result)                                ;don't build it
+          (else
+           (cons package result))))
+
+  (fold-packages adjust
+                 (fold adjust '()                 ;include base packages
+                       (match (%final-inputs)
+                         (((labels packages _ ...) ...)
+                          packages)))
+                 #:select? (const #t)))           ;include hidden packages
+
+(define (arguments->manifests arguments)
+  "Return the list of manifests extracted from ARGUMENTS."
+  (map (match-lambda
+         ((input-name . relative-path)
+          (let* ((checkout (assq-ref arguments (string->symbol input-name)))
+                 (base (assq-ref checkout 'file-name)))
+            (in-vicinity base relative-path))))
+       (assq-ref arguments 'manifests)))
+
+(define (manifests->packages store manifests)
+  "Return the list of packages found in MANIFESTS."
+  (define (load-manifest manifest)
+    (save-module-excursion
+     (lambda ()
+       (set-current-module (make-user-module '((guix profiles) (gnu))))
+       (primitive-load manifest))))
+
+  (delete-duplicates!
+   (map manifest-entry-item
+        (append-map (compose manifest-entries
+                             load-manifest)
+                    manifests))))
+
+
+;;;
+;;; Hydra entry point.
+;;;
+
+(define (hydra-jobs store arguments)
+  "Return Hydra jobs."
+  (define subset
+    (match (assoc-ref arguments 'subset)
+      ("core" 'core)                              ; only build core packages
+      ("hello" 'hello)                            ; only build hello
+      (((? string?) (? string?) ...) 'list)       ; only build selected list of packages
+      ("manifests" 'manifests)                    ; only build packages in the list of manifests
+      (_ 'all)))                                  ; build everything
+
+  (define systems
+    (match (assoc-ref arguments 'systems)
+      (#f              %hydra-supported-systems)
+      ((lst ...)       lst)
+      ((? string? str) (call-with-input-string str read))))
+
+  (define (cross-jobs system)
+    (define (from-32-to-64? target)
+      ;; Return true if SYSTEM is 32-bit and TARGET is 64-bit.  This hack
+      ;; prevents known-to-fail cross-builds from i686-linux or armhf-linux to
+      ;; mips64el-linux-gnuabi64.
+      (and (or (string-prefix? "i686-" system)
+               (string-prefix? "i586-" system)
+               (string-prefix? "armhf-" system))
+           (string-contains target "64")))    ;x86_64, mips64el, aarch64, etc.
+
+    (define (same? target)
+      ;; Return true if SYSTEM and TARGET are the same thing.  This is so we
+      ;; don't try to cross-compile to 'mips64el-linux-gnu' from
+      ;; 'mips64el-linux'.
+      (or (string-contains target system)
+          (and (string-prefix? "armhf" system)    ;armhf-linux
+               (string-prefix? "arm" target))))   ;arm-linux-gnueabihf
+
+    (define (pointless? target)
+      ;; Return #t if it makes no sense to cross-build to TARGET from SYSTEM.
+      (match system
+        ((or "x86_64-linux" "i686-linux")
+         (if (string-contains target "mingw")
+             (not (string=? "x86_64-linux" system))
+             #f))
+        (_
+         ;; Don't try to cross-compile from non-Intel platforms: this isn't
+         ;; very useful and these are often brittle configurations.
+         #t)))
+
+    (define (either proc1 proc2 proc3)
+      (lambda (x)
+        (or (proc1 x) (proc2 x) (proc3 x))))
+
+    (append-map (lambda (target)
+                  (map (lambda (package)
+                         (package-cross-job store (job-name package)
+                                            package target system))
+                       %packages-to-cross-build))
+                (remove (either from-32-to-64? same? pointless?)
+                        %cross-targets)))
+
+  ;; Turn off grafts.  Grafting is meant to happen on the user's machines.
+  (parameterize ((%graft? #f))
+    ;; Return one job for each package, except bootstrap packages.
+    (append-map (lambda (system)
+                  (format (current-error-port)
+                          "evaluating for '~a' (heap size: ~a MiB)...~%"
+                          system
+                          (round
+                           (/ (assoc-ref (gc-stats) 'heap-size)
+                              (expt 2. 20))))
+                  (invalidate-derivation-caches!)
+                  (case subset
+                    ((all)
+                     ;; Build everything, including replacements.
+                     (let ((all (all-packages))
+                           (job (lambda (package)
+                                  (package->job store package
+                                                system))))
+                       (append (filter-map job all)
+                               (qemu-jobs store system)
+                               (system-test-jobs store system)
+                               (tarball-jobs store system)
+                               (cross-jobs system))))
+                    ((core)
+                     ;; Build core packages only.
+                     (append (map (lambda (package)
+                                    (package-job store (job-name package)
+                                                 package system))
+                                  %core-packages)
+                             (cross-jobs system)))
+                    ((hello)
+                     ;; Build hello package only.
+                     (if (string=? system (%current-system))
+                         (let ((hello (specification->package "hello")))
+                           (list (package-job store (job-name hello) hello system)))
+                         '()))
+                    ((list)
+                     ;; Build selected list of packages only.
+                     (if (string=? system (%current-system))
+                         (let* ((names (assoc-ref arguments 'subset))
+                                (packages (map specification->package names)))
+                           (map (lambda (package)
+                                    (package-job store (job-name package)
+                                                 package system))
+                                  packages))
+                         '()))
+                    ((manifests)
+                     ;; Build packages in the list of manifests.
+                     (let* ((manifests (arguments->manifests arguments))
+                            (packages (manifests->packages store manifests)))
+                       (map (lambda (package)
+                              (package-job store (job-name package)
+                                           package system))
+                            packages)))
+                    (else
+                     (error "unknown subset" subset))))
+                systems)))
diff --git a/gnu/local.mk b/gnu/local.mk
index 3350e5abac..1d43250557 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -550,7 +550,9 @@ GNU_SYSTEM_MODULES =				\
   %D%/tests/ssh.scm				\
   %D%/tests/version-control.scm			\
   %D%/tests/virtualization.scm			\
-  %D%/tests/web.scm
+  %D%/tests/web.scm				\
+						\
+  %D%/ci.scm
 
 # Modules that do not need to be compiled.
 MODULES_NOT_COMPILED +=				\
-- 
2.19.1





Information forwarded to guix-patches@HIDDEN:
bug#33515; Package guix-patches. Full text available.

Message received at 33515 <at> debbugs.gnu.org:


Received: (at 33515) by debbugs.gnu.org; 26 Nov 2018 16:45:54 +0000
From debbugs-submit-bounces <at> debbugs.gnu.org Mon Nov 26 11:45:54 2018
Received: from localhost ([127.0.0.1]:50051 helo=debbugs.gnu.org)
	by debbugs.gnu.org with esmtp (Exim 4.84_2)
	(envelope-from <debbugs-submit-bounces <at> debbugs.gnu.org>)
	id 1gRK1C-0002SG-28
	for submit <at> debbugs.gnu.org; Mon, 26 Nov 2018 11:45:54 -0500
Received: from eggs.gnu.org ([208.118.235.92]:60924)
 by debbugs.gnu.org with esmtp (Exim 4.84_2)
 (envelope-from <ludo@HIDDEN>) id 1gRK14-0002Gg-Mc
 for 33515 <at> debbugs.gnu.org; Mon, 26 Nov 2018 11:45:48 -0500
Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71)
 (envelope-from <ludo@HIDDEN>) id 1gRK0y-00077C-E7
 for 33515 <at> debbugs.gnu.org; Mon, 26 Nov 2018 11:45:41 -0500
X-Spam-Checker-Version: SpamAssassin 3.3.2 (2011-06-06) on eggs.gnu.org
X-Spam-Level: 
X-Spam-Status: No, score=0.8 required=5.0 tests=BAYES_50 autolearn=disabled
 version=3.3.2
Received: from fencepost.gnu.org ([2001:4830:134:3::e]:51263)
 by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from <ludo@HIDDEN>)
 id 1gRK0w-00075J-7S; Mon, 26 Nov 2018 11:45:38 -0500
Received: from [2001:660:6102:320:e120:2c8f:8909:cdfe] (port=51762
 helo=gnu.org)
 by fencepost.gnu.org with esmtpsa (TLS1.2:DHE_RSA_AES_256_CBC_SHA1:256)
 (Exim 4.82) (envelope-from <ludo@HIDDEN>)
 id 1gRK0v-00051o-VU; Mon, 26 Nov 2018 11:45:38 -0500
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@HIDDEN>
To: 33515 <at> debbugs.gnu.org
Subject: [PATCH 5/5] hydra: Compute jobs in an inferior.
Date: Mon, 26 Nov 2018 17:45:24 +0100
Message-Id: <20181126164524.17680-5-ludo@HIDDEN>
X-Mailer: git-send-email 2.19.1
In-Reply-To: <20181126164524.17680-1-ludo@HIDDEN>
References: <20181126164524.17680-1-ludo@HIDDEN>
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic]
X-Received-From: 2001:4830:134:3::e
X-Spam-Score: -5.0 (-----)
X-Debbugs-Envelope-To: 33515
Cc: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@HIDDEN>
X-BeenThere: debbugs-submit <at> debbugs.gnu.org
X-Mailman-Version: 2.1.18
Precedence: list
List-Id: <debbugs-submit.debbugs.gnu.org>
List-Unsubscribe: <https://debbugs.gnu.org/cgi-bin/mailman/options/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=unsubscribe>
List-Archive: <https://debbugs.gnu.org/cgi-bin/mailman/private/debbugs-submit/>
List-Post: <mailto:debbugs-submit <at> debbugs.gnu.org>
List-Help: <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=help>
List-Subscribe: <https://debbugs.gnu.org/cgi-bin/mailman/listinfo/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=subscribe>
Errors-To: debbugs-submit-bounces <at> debbugs.gnu.org
Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
X-Spam-Score: -6.0 (------)

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).
---
 build-aux/hydra/gnu-system.scm | 71 ++++++++++++++++++++--------------
 gnu/ci.scm                     | 20 +++++++---
 guix/self.scm                  |  3 +-
 3 files changed, 58 insertions(+), 36 deletions(-)

diff --git a/build-aux/hydra/gnu-system.scm b/build-aux/hydra/gnu-system.scm
index 150c2bdf4f..db91440854 100644
--- a/build-aux/hydra/gnu-system.scm
+++ b/build-aux/hydra/gnu-system.scm
@@ -23,39 +23,50 @@
 ;;; 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)
+             (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
+    (or (assq-ref arguments 'guix)                ;Hydra on hydra
+        (assq-ref arguments 'guix-modular)))      ;Cuirass on berlin
+
+  (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)))))))
diff --git a/gnu/ci.scm b/gnu/ci.scm
index 8ece08e453..8daf9e7e35 100644
--- a/gnu/ci.scm
+++ b/gnu/ci.scm
@@ -27,7 +27,8 @@
   #: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 @@
                                           #: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@HIDDEN"))
       (max-silent-time . ,(or (assoc-ref (package-properties package)
@@ -133,7 +143,7 @@ SYSTEM."
       (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+))
       (home-page . ,%guix-home-page-url)
       (maintainers . ("bug-guix@HIDDEN"))))
 
@@ -192,7 +202,7 @@ system.")
         (description . ,(format #f "GuixSD '~a' system test"
                                 (system-test-name test)))
         (long-description . ,(system-test-description test))
-        (license . ,gpl3+)
+        (license . ,(license-name gpl3+))
         (home-page . ,%guix-home-page-url)
         (maintainers . ("bug-guix@HIDDEN")))))
 
@@ -213,7 +223,7 @@ system.")
       (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@HIDDEN"))))
 
diff --git a/guix/self.scm b/guix/self.scm
index 96fef44e78..065705641d 100644
--- a/guix/self.scm
+++ b/guix/self.scm
@@ -613,7 +613,8 @@ assumed to be part of 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*)
-- 
2.19.1





Information forwarded to guix-patches@HIDDEN:
bug#33515; Package guix-patches. Full text available.

Message received at 33515 <at> debbugs.gnu.org:


Received: (at 33515) by debbugs.gnu.org; 26 Nov 2018 16:45:50 +0000
From debbugs-submit-bounces <at> debbugs.gnu.org Mon Nov 26 11:45:50 2018
Received: from localhost ([127.0.0.1]:50049 helo=debbugs.gnu.org)
	by debbugs.gnu.org with esmtp (Exim 4.84_2)
	(envelope-from <debbugs-submit-bounces <at> debbugs.gnu.org>)
	id 1gRK17-0002O4-LO
	for submit <at> debbugs.gnu.org; Mon, 26 Nov 2018 11:45:49 -0500
Received: from eggs.gnu.org ([208.118.235.92]:60908)
 by debbugs.gnu.org with esmtp (Exim 4.84_2)
 (envelope-from <ludo@HIDDEN>) id 1gRK13-0002FJ-56
 for 33515 <at> debbugs.gnu.org; Mon, 26 Nov 2018 11:45:45 -0500
Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71)
 (envelope-from <ludo@HIDDEN>) id 1gRK0x-00075x-Bt
 for 33515 <at> debbugs.gnu.org; Mon, 26 Nov 2018 11:45:40 -0500
X-Spam-Checker-Version: SpamAssassin 3.3.2 (2011-06-06) on eggs.gnu.org
X-Spam-Level: 
X-Spam-Status: No, score=-1.9 required=5.0 tests=BAYES_00 autolearn=disabled
 version=3.3.2
Received: from fencepost.gnu.org ([2001:4830:134:3::e]:51262)
 by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from <ludo@HIDDEN>)
 id 1gRK0v-000754-JD; Mon, 26 Nov 2018 11:45:37 -0500
Received: from [2001:660:6102:320:e120:2c8f:8909:cdfe] (port=51762
 helo=gnu.org)
 by fencepost.gnu.org with esmtpsa (TLS1.2:DHE_RSA_AES_256_CBC_SHA1:256)
 (Exim 4.82) (envelope-from <ludo@HIDDEN>)
 id 1gRK0v-00051o-AI; Mon, 26 Nov 2018 11:45:37 -0500
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@HIDDEN>
To: 33515 <at> debbugs.gnu.org
Subject: [PATCH 4/5] channels: Add 'checkout->channel-instance'.
Date: Mon, 26 Nov 2018 17:45:23 +0100
Message-Id: <20181126164524.17680-4-ludo@HIDDEN>
X-Mailer: git-send-email 2.19.1
In-Reply-To: <20181126164524.17680-1-ludo@HIDDEN>
References: <20181126164524.17680-1-ludo@HIDDEN>
MIME-Version: 1.0
Content-Transfer-Encoding: 8bit
X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic]
X-Received-From: 2001:4830:134:3::e
X-Spam-Score: -5.0 (-----)
X-Debbugs-Envelope-To: 33515
Cc: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@HIDDEN>
X-BeenThere: debbugs-submit <at> debbugs.gnu.org
X-Mailman-Version: 2.1.18
Precedence: list
List-Id: <debbugs-submit.debbugs.gnu.org>
List-Unsubscribe: <https://debbugs.gnu.org/cgi-bin/mailman/options/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=unsubscribe>
List-Archive: <https://debbugs.gnu.org/cgi-bin/mailman/private/debbugs-submit/>
List-Post: <mailto:debbugs-submit <at> debbugs.gnu.org>
List-Help: <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=help>
List-Subscribe: <https://debbugs.gnu.org/cgi-bin/mailman/listinfo/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=subscribe>
Errors-To: debbugs-submit-bounces <at> debbugs.gnu.org
Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
X-Spam-Score: -6.0 (------)

* guix/channels.scm (checkout->channel-instance): New procedure.
---
 guix/channels.scm | 12 ++++++++++++
 1 file changed, 12 insertions(+)

diff --git a/guix/channels.scm b/guix/channels.scm
index 82389eb583..e57da68149 100644
--- a/guix/channels.scm
+++ b/guix/channels.scm
@@ -47,6 +47,7 @@
             channel-instance-checkout
 
             latest-channel-instances
+            checkout->channel-instance
             latest-channel-derivation
             channel-instances->manifest
             channel-instances->derivation))
@@ -114,6 +115,17 @@ CHANNELS."
            (channel-instance channel commit checkout)))
        channels))
 
+(define* (checkout->channel-instance checkout
+                                     #:key commit
+                                     (url checkout) (name 'guix))
+  "Return a channel instance for CHECKOUT, which is assumed to be a checkout
+of COMMIT at URL.  Use NAME as the channel name."
+  (let* ((commit  (or commit (make-string 40 #\0)))
+         (channel (channel (name name)
+                           (commit commit)
+                           (url url))))
+    (channel-instance channel commit checkout)))
+
 (define %self-build-file
   ;; The file containing code to build Guix.  This serves the same purpose as
   ;; a makefile, and, similarly, is intended to always keep this name.
-- 
2.19.1





Information forwarded to guix-patches@HIDDEN:
bug#33515; Package guix-patches. Full text available.

Message received at 33515 <at> debbugs.gnu.org:


Received: (at 33515) by debbugs.gnu.org; 26 Nov 2018 16:45:49 +0000
From debbugs-submit-bounces <at> debbugs.gnu.org Mon Nov 26 11:45:49 2018
Received: from localhost ([127.0.0.1]:50047 helo=debbugs.gnu.org)
	by debbugs.gnu.org with esmtp (Exim 4.84_2)
	(envelope-from <debbugs-submit-bounces <at> debbugs.gnu.org>)
	id 1gRK16-0002NY-Va
	for submit <at> debbugs.gnu.org; Mon, 26 Nov 2018 11:45:49 -0500
Received: from eggs.gnu.org ([208.118.235.92]:60903)
 by debbugs.gnu.org with esmtp (Exim 4.84_2)
 (envelope-from <ludo@HIDDEN>) id 1gRK12-0002Et-Sw
 for 33515 <at> debbugs.gnu.org; Mon, 26 Nov 2018 11:45:45 -0500
Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71)
 (envelope-from <ludo@HIDDEN>) id 1gRK0w-00075X-K1
 for 33515 <at> debbugs.gnu.org; Mon, 26 Nov 2018 11:45:39 -0500
X-Spam-Checker-Version: SpamAssassin 3.3.2 (2011-06-06) on eggs.gnu.org
X-Spam-Level: 
X-Spam-Status: No, score=-0.0 required=5.0 tests=BAYES_40 autolearn=disabled
 version=3.3.2
Received: from fencepost.gnu.org ([2001:4830:134:3::e]:51258)
 by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from <ludo@HIDDEN>)
 id 1gRK0t-000748-3Q; Mon, 26 Nov 2018 11:45:35 -0500
Received: from [2001:660:6102:320:e120:2c8f:8909:cdfe] (port=51762
 helo=gnu.org)
 by fencepost.gnu.org with esmtpsa (TLS1.2:DHE_RSA_AES_256_CBC_SHA1:256)
 (Exim 4.82) (envelope-from <ludo@HIDDEN>)
 id 1gRK0s-00051o-QP; Mon, 26 Nov 2018 11:45:35 -0500
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@HIDDEN>
To: 33515 <at> debbugs.gnu.org
Subject: [PATCH 1/5] inferior: Add 'inferior-eval-with-store'.
Date: Mon, 26 Nov 2018 17:45:20 +0100
Message-Id: <20181126164524.17680-1-ludo@HIDDEN>
X-Mailer: git-send-email 2.19.1
MIME-Version: 1.0
Content-Transfer-Encoding: 8bit
X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic]
X-Received-From: 2001:4830:134:3::e
X-Spam-Score: -5.0 (-----)
X-Debbugs-Envelope-To: 33515
Cc: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@HIDDEN>
X-BeenThere: debbugs-submit <at> debbugs.gnu.org
X-Mailman-Version: 2.1.18
Precedence: list
List-Id: <debbugs-submit.debbugs.gnu.org>
List-Unsubscribe: <https://debbugs.gnu.org/cgi-bin/mailman/options/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=unsubscribe>
List-Archive: <https://debbugs.gnu.org/cgi-bin/mailman/private/debbugs-submit/>
List-Post: <mailto:debbugs-submit <at> debbugs.gnu.org>
List-Help: <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=help>
List-Subscribe: <https://debbugs.gnu.org/cgi-bin/mailman/listinfo/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=subscribe>
Errors-To: debbugs-submit-bounces <at> debbugs.gnu.org
Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
X-Spam-Score: -6.0 (------)

* guix/inferior.scm (inferior-eval-with-store): New procedure, with code
formerly in 'inferior-package-derivation'.
(inferior-package-derivation): Rewrite in terms of
'inferior-eval-with-store'.
* tests/inferior.scm ("inferior-eval-with-store"): New test.
---
 guix/inferior.scm  | 70 ++++++++++++++++++++++++++++------------------
 tests/inferior.scm |  9 ++++++
 2 files changed, 52 insertions(+), 27 deletions(-)

diff --git a/guix/inferior.scm b/guix/inferior.scm
index 1dbb9e1699..ccc1c27cb2 100644
--- a/guix/inferior.scm
+++ b/guix/inferior.scm
@@ -56,6 +56,7 @@
             open-inferior
             close-inferior
             inferior-eval
+            inferior-eval-with-store
             inferior-object?
 
             inferior-packages
@@ -402,55 +403,70 @@ input/output ports.)"
        (unless (port-closed? client)
          (loop))))))
 
-(define* (inferior-package-derivation store package
-                                      #:optional
-                                      (system (%current-system))
-                                      #:key target)
-  "Return the derivation for PACKAGE, an inferior package, built for SYSTEM
-and cross-built for TARGET if TARGET is true.  The inferior corresponding to
-PACKAGE must be live."
-  ;; Create a named socket in /tmp and let the inferior of PACKAGE connect to
-  ;; it and use it as its store.  This ensures the inferior uses the same
-  ;; store, with the same options, the same per-session GC roots, etc.
+(define (inferior-eval-with-store inferior store code)
+  "Evaluate CODE in INFERIOR, passing it STORE as its argument.  CODE must
+thus be the code of a one-argument procedure that accepts a store."
+  ;; Create a named socket in /tmp and let INFERIOR connect to it and use it
+  ;; as its store.  This ensures the inferior uses the same store, with the
+  ;; same options, the same per-session GC roots, etc.
   (call-with-temporary-directory
    (lambda (directory)
      (chmod directory #o700)
      (let* ((name     (string-append directory "/inferior"))
             (socket   (socket AF_UNIX SOCK_STREAM 0))
-            (inferior (inferior-package-inferior package))
             (major    (nix-server-major-version store))
             (minor    (nix-server-minor-version store))
             (proto    (logior major minor)))
        (bind socket AF_UNIX name)
        (listen socket 1024)
        (send-inferior-request
-        `(let ((socket (socket AF_UNIX SOCK_STREAM 0)))
+        `(let ((proc   ,code)
+               (socket (socket AF_UNIX SOCK_STREAM 0)))
            (connect socket AF_UNIX ,name)
 
            ;; 'port->connection' appeared in June 2018 and we can hardly
            ;; emulate it on older versions.  Thus fall back to
            ;; 'open-connection', at the risk of talking to the wrong daemon or
            ;; having our build result reclaimed (XXX).
-           (let* ((store   (if (defined? 'port->connection)
-                               (port->connection socket #:version ,proto)
-                               (open-connection)))
-                  (package (hashv-ref %package-table
-                                      ,(inferior-package-id package)))
-                  (drv     ,(if target
-                                `(package-cross-derivation store package
-                                                           ,target
-                                                           ,system)
-                                `(package-derivation store package
-                                                     ,system))))
-             (close-connection store)
-             (close-port socket)
-             (derivation-file-name drv)))
+           (let ((store (if (defined? 'port->connection)
+                            (port->connection socket #:version ,proto)
+                            (open-connection))))
+             (dynamic-wind
+               (const #t)
+               (lambda ()
+                 (proc store))
+               (lambda ()
+                 (close-connection store)
+                 (close-port socket)))))
         inferior)
        (match (accept socket)
          ((client . address)
           (proxy client (nix-server-socket store))))
        (close-port socket)
-       (read-derivation-from-file (read-inferior-response inferior))))))
+       (read-inferior-response inferior)))))
+
+(define* (inferior-package-derivation store package
+                                      #:optional
+                                      (system (%current-system))
+                                      #:key target)
+  "Return the derivation for PACKAGE, an inferior package, built for SYSTEM
+and cross-built for TARGET if TARGET is true.  The inferior corresponding to
+PACKAGE must be live."
+  (define proc
+    `(lambda (store)
+       (let* ((package (hashv-ref %package-table
+                                  ,(inferior-package-id package)))
+              (drv     ,(if target
+                            `(package-cross-derivation store package
+                                                       ,target
+                                                       ,system)
+                            `(package-derivation store package
+                                                 ,system))))
+         (derivation-file-name drv))))
+
+  (and=> (inferior-eval-with-store (inferior-package-inferior package) store
+                                   proc)
+         read-derivation-from-file))
 
 (define inferior-package->derivation
   (store-lift inferior-package-derivation))
diff --git a/tests/inferior.scm b/tests/inferior.scm
index d1d5c00a77..d5a894ca8f 100644
--- a/tests/inferior.scm
+++ b/tests/inferior.scm
@@ -157,6 +157,15 @@
     (close-inferior inferior)
     result))
 
+(test-equal "inferior-eval-with-store"
+  (add-text-to-store %store "foo" "Hello, world!")
+  (let* ((inferior (open-inferior %top-builddir
+                                  #:command "scripts/guix")))
+    (inferior-eval-with-store inferior %store
+                              '(lambda (store)
+                                 (add-text-to-store store "foo"
+                                                    "Hello, world!")))))
+
 (test-equal "inferior-package-derivation"
   (map derivation-file-name
        (list (package-derivation %store %bootstrap-guile "x86_64-linux")
-- 
2.19.1





Information forwarded to guix-patches@HIDDEN:
bug#33515; Package guix-patches. Full text available.

Message received at 33515 <at> debbugs.gnu.org:


Received: (at 33515) by debbugs.gnu.org; 26 Nov 2018 16:45:49 +0000
From debbugs-submit-bounces <at> debbugs.gnu.org Mon Nov 26 11:45:49 2018
Received: from localhost ([127.0.0.1]:50044 helo=debbugs.gnu.org)
	by debbugs.gnu.org with esmtp (Exim 4.84_2)
	(envelope-from <debbugs-submit-bounces <at> debbugs.gnu.org>)
	id 1gRK14-0002LO-Pa
	for submit <at> debbugs.gnu.org; Mon, 26 Nov 2018 11:45:47 -0500
Received: from eggs.gnu.org ([208.118.235.92]:60905)
 by debbugs.gnu.org with esmtp (Exim 4.84_2)
 (envelope-from <ludo@HIDDEN>) id 1gRK12-0002Ez-T0
 for 33515 <at> debbugs.gnu.org; Mon, 26 Nov 2018 11:45:45 -0500
Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71)
 (envelope-from <ludo@HIDDEN>) id 1gRK0w-00075n-VK
 for 33515 <at> debbugs.gnu.org; Mon, 26 Nov 2018 11:45:39 -0500
X-Spam-Checker-Version: SpamAssassin 3.3.2 (2011-06-06) on eggs.gnu.org
X-Spam-Level: 
X-Spam-Status: No, score=-1.9 required=5.0 tests=BAYES_00 autolearn=disabled
 version=3.3.2
Received: from fencepost.gnu.org ([2001:4830:134:3::e]:51260)
 by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from <ludo@HIDDEN>)
 id 1gRK0u-00074f-Sk; Mon, 26 Nov 2018 11:45:36 -0500
Received: from [2001:660:6102:320:e120:2c8f:8909:cdfe] (port=51762
 helo=gnu.org)
 by fencepost.gnu.org with esmtpsa (TLS1.2:DHE_RSA_AES_256_CBC_SHA1:256)
 (Exim 4.82) (envelope-from <ludo@HIDDEN>)
 id 1gRK0u-00051o-JD; Mon, 26 Nov 2018 11:45:36 -0500
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@HIDDEN>
To: 33515 <at> debbugs.gnu.org
Subject: [PATCH 3/5] hydra: evaluate: Add the checkout to the store.
Date: Mon, 26 Nov 2018 17:45:22 +0100
Message-Id: <20181126164524.17680-3-ludo@HIDDEN>
X-Mailer: git-send-email 2.19.1
In-Reply-To: <20181126164524.17680-1-ludo@HIDDEN>
References: <20181126164524.17680-1-ludo@HIDDEN>
MIME-Version: 1.0
Content-Transfer-Encoding: 8bit
X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic]
X-Received-From: 2001:4830:134:3::e
X-Spam-Score: -5.0 (-----)
X-Debbugs-Envelope-To: 33515
Cc: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@HIDDEN>
X-BeenThere: debbugs-submit <at> debbugs.gnu.org
X-Mailman-Version: 2.1.18
Precedence: list
List-Id: <debbugs-submit.debbugs.gnu.org>
List-Unsubscribe: <https://debbugs.gnu.org/cgi-bin/mailman/options/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=unsubscribe>
List-Archive: <https://debbugs.gnu.org/cgi-bin/mailman/private/debbugs-submit/>
List-Post: <mailto:debbugs-submit <at> debbugs.gnu.org>
List-Help: <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=help>
List-Subscribe: <https://debbugs.gnu.org/cgi-bin/mailman/listinfo/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=subscribe>
Errors-To: debbugs-submit-bounces <at> debbugs.gnu.org
Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
X-Spam-Score: -6.0 (------)

* build-aux/hydra/evaluate.scm <top level>: Add call to 'add-to-store'.
Use that as the 'file-name' attribute.  Call 'primitive-load' in a
directory excursion to SOURCE.
---
 build-aux/hydra/evaluate.scm | 55 +++++++++++++++++++++---------------
 1 file changed, 33 insertions(+), 22 deletions(-)

diff --git a/build-aux/hydra/evaluate.scm b/build-aux/hydra/evaluate.scm
index 5793c022ff..adb14808fa 100644
--- a/build-aux/hydra/evaluate.scm
+++ b/build-aux/hydra/evaluate.scm
@@ -22,6 +22,8 @@
 ;;; arguments and outputs an sexp of the jobs on standard output.
 
 (use-modules (guix store)
+             (guix git-download)
+             ((guix build utils) #:select (with-directory-excursion))
              (srfi srfi-19)
              (ice-9 match)
              (ice-9 pretty-print)
@@ -81,11 +83,6 @@ Otherwise return THING."
    ;; Load FILE, a Scheme file that defines Hydra jobs.
    (let ((port (current-output-port))
          (real-build-things build-things))
-     (save-module-excursion
-      (lambda ()
-        (set-current-module %user-module)
-        (primitive-load file)))
-
      (with-store store
        ;; Make sure we don't resort to substitutes.
        (set-build-options store
@@ -104,23 +101,37 @@ Otherwise return THING."
                    "'build-things' arguments: ~s~%" args)
            (apply real-build-things store args)))
 
-       ;; Call the entry point of FILE and print the resulting job sexp.
-       (pretty-print
-        (match ((module-ref %user-module
-                            (if (equal? cuirass? "cuirass")
-                                'cuirass-jobs
-                                'hydra-jobs))
-                store `((guix
-                         . ((file-name . ,%top-srcdir)))))
-          (((names . thunks) ...)
-           (map (lambda (job thunk)
-                  (format (current-error-port) "evaluating '~a'... " job)
-                  (force-output (current-error-port))
-                  (cons job
-                        (assert-valid-job job
-                                          (call-with-time-display thunk))))
-                names thunks)))
-        port))))
+       ;; Add %TOP-SRCDIR to the store with a proper Git predicate so we work
+       ;; from a clean checkout
+       (let ((source (add-to-store store "guix-source" #t
+                                   "sha256" %top-srcdir
+                                   #:select? (git-predicate %top-srcdir))))
+         (with-directory-excursion source
+           (save-module-excursion
+            (lambda ()
+              (set-current-module %user-module)
+              (format (current-error-port)
+                      "loading '~a' relative to '~a'...~%"
+                      file source)
+              (primitive-load file))))
+
+         ;; Call the entry point of FILE and print the resulting job sexp.
+         (pretty-print
+          (match ((module-ref %user-module
+                              (if (equal? cuirass? "cuirass")
+                                  'cuirass-jobs
+                                  'hydra-jobs))
+                  store `((guix
+                           . ((file-name . ,source)))))
+            (((names . thunks) ...)
+             (map (lambda (job thunk)
+                    (format (current-error-port) "evaluating '~a'... " job)
+                    (force-output (current-error-port))
+                    (cons job
+                          (assert-valid-job job
+                                            (call-with-time-display thunk))))
+                  names thunks)))
+          port)))))
   ((command _ ...)
    (format (current-error-port) "Usage: ~a FILE [cuirass]
 Evaluate the Hydra or Cuirass jobs defined in FILE.~%"
-- 
2.19.1





Information forwarded to guix-patches@HIDDEN:
bug#33515; Package guix-patches. Full text available.

Message received at submit <at> debbugs.gnu.org:


Received: (at submit) by debbugs.gnu.org; 26 Nov 2018 16:38:26 +0000
From debbugs-submit-bounces <at> debbugs.gnu.org Mon Nov 26 11:38:26 2018
Received: from localhost ([127.0.0.1]:50036 helo=debbugs.gnu.org)
	by debbugs.gnu.org with esmtp (Exim 4.84_2)
	(envelope-from <debbugs-submit-bounces <at> debbugs.gnu.org>)
	id 1gRJtx-0001Wa-Uc
	for submit <at> debbugs.gnu.org; Mon, 26 Nov 2018 11:38:26 -0500
Received: from eggs.gnu.org ([208.118.235.92]:58832)
 by debbugs.gnu.org with esmtp (Exim 4.84_2)
 (envelope-from <ludo@HIDDEN>) id 1gRJtv-0001WJ-Uc
 for submit <at> debbugs.gnu.org; Mon, 26 Nov 2018 11:38:24 -0500
Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71)
 (envelope-from <ludo@HIDDEN>) id 1gRJtq-0001Mh-5P
 for submit <at> debbugs.gnu.org; Mon, 26 Nov 2018 11:38:18 -0500
X-Spam-Checker-Version: SpamAssassin 3.3.2 (2011-06-06) on eggs.gnu.org
X-Spam-Level: 
X-Spam-Status: No, score=-1.9 required=5.0 tests=BAYES_00 autolearn=disabled
 version=3.3.2
Received: from lists.gnu.org ([2001:4830:134:3::11]:53149)
 by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_256_CBC_SHA1:32)
 (Exim 4.71) (envelope-from <ludo@HIDDEN>) id 1gRJtp-0001Ma-WF
 for submit <at> debbugs.gnu.org; Mon, 26 Nov 2018 11:38:18 -0500
Received: from eggs.gnu.org ([2001:4830:134:3::10]:40199)
 by lists.gnu.org with esmtp (Exim 4.71)
 (envelope-from <ludo@HIDDEN>) id 1gRJtp-0007NW-3N
 for guix-patches@HIDDEN; Mon, 26 Nov 2018 11:38:17 -0500
Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71)
 (envelope-from <ludo@HIDDEN>) id 1gRJto-0001M1-Ez
 for guix-patches@HIDDEN; Mon, 26 Nov 2018 11:38:17 -0500
Received: from fencepost.gnu.org ([2001:4830:134:3::e]:51114)
 by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from <ludo@HIDDEN>)
 id 1gRJtm-0001LH-MC; Mon, 26 Nov 2018 11:38:14 -0500
Received: from [2001:660:6102:320:e120:2c8f:8909:cdfe] (port=51744
 helo=gnu.org)
 by fencepost.gnu.org with esmtpsa (TLS1.2:DHE_RSA_AES_256_CBC_SHA1:256)
 (Exim 4.82) (envelope-from <ludo@HIDDEN>)
 id 1gRJtm-0004Nw-E9; Mon, 26 Nov 2018 11:38:14 -0500
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@HIDDEN>
To: guix-patches@HIDDEN
Subject: [PATCH 0/5] Cuirass/Hydra: evaluate jobs in an inferior
Date: Mon, 26 Nov 2018 17:37:57 +0100
Message-Id: <20181126163757.17399-1-ludo@HIDDEN>
X-Mailer: git-send-email 2.19.1
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic]
X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.6.x
X-Received-From: 2001:4830:134:3::11
X-Spam-Score: -5.0 (-----)
X-Debbugs-Envelope-To: submit
Cc: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@HIDDEN>
X-BeenThere: debbugs-submit <at> debbugs.gnu.org
X-Mailman-Version: 2.1.18
Precedence: list
List-Id: <debbugs-submit.debbugs.gnu.org>
List-Unsubscribe: <https://debbugs.gnu.org/cgi-bin/mailman/options/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=unsubscribe>
List-Archive: <https://debbugs.gnu.org/cgi-bin/mailman/private/debbugs-submit/>
List-Post: <mailto:debbugs-submit <at> debbugs.gnu.org>
List-Help: <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=help>
List-Subscribe: <https://debbugs.gnu.org/cgi-bin/mailman/listinfo/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=subscribe>
Errors-To: debbugs-submit-bounces <at> debbugs.gnu.org
Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
X-Spam-Score: -6.0 (------)

Hello Guix!

This patch set changes the way we compute continuous integration jobs:
instead of letting Guile auto-compile all of Guix from its checkout,
we first build Guix in the same way as ‘guix pull’, open an inferior
to that Guix, and run the job evaluation code in that inferior.

I think it’s cleaner and it should be faster and less resource-hungry
than the current approach.

The build-aux/hydra/gnu-system.scm file will now rely on the
(guix channels) and (guix inferior) with the new ‘checkout->channel-instance’
and ‘inferior-eval-with-store’ procedures, which means that Cuirass
(and Hydra) will need to be using a recent Guix to be able to perform
the evaluation.  Apart from that ‘gnu-system.scm’ is rather decoupled
from the Guix APIs.

To test it for real, we’ll first have to apply the patches that add these
two procedures to ‘master’ and to update the ‘guix’ package so we can
have a Cuirass instance running the latest and greatest.

Thoughts?

Ludo’.

Ludovic Courtès (5):
  inferior: Add 'inferior-eval-with-store'.
  hydra: Move job definitions to (gnu ci).
  hydra: evaluate: Add the checkout to the store.
  channels: Add 'checkout->channel-instance'.
  hydra: Compute jobs in an inferior.

 build-aux/hydra/evaluate.scm   |  55 ++--
 build-aux/hydra/gnu-system.scm | 448 +++------------------------------
 gnu/ci.scm                     | 440 ++++++++++++++++++++++++++++++++
 gnu/local.mk                   |   4 +-
 guix/channels.scm              |  12 +
 guix/inferior.scm              |  70 ++++--
 guix/self.scm                  |   3 +-
 tests/inferior.scm             |   9 +
 8 files changed, 573 insertions(+), 468 deletions(-)
 create mode 100644 gnu/ci.scm

-- 
2.19.1





Acknowledgement sent to Ludovic Courtès <ludo@HIDDEN>:
New bug report received and forwarded. Copy sent to guix-patches@HIDDEN. Full text available.
Report forwarded to guix-patches@HIDDEN:
bug#33515; Package guix-patches. Full text available.
Please note: This is a static page, with minimal formatting, updated once a day.
Click here to see this page with the latest information and nicer formatting.
Last modified: Mon, 26 Nov 2018 16:45:02 UTC

GNU bug tracking system
Copyright (C) 1999 Darren O. Benham, 1997 nCipher Corporation Ltd, 1994-97 Ian Jackson.