gnu: mpop: Update to 1.4.7.

[jackhill/guix/guix.git] / gnu / ci.scm

diff --git a/gnu/ci.scm b/gnu/ci.scm
index 943fbb6..d6eb2d0 100644 (file)
--- a/gnu/ci.scm
+++ b/gnu/ci.scm
@@ -1,7 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2017 Jan Nieuwenhuizen <janneke@gnu.org>
-;;; Copyright © 2018 Clément Lassieur <clement@lassieur.org>
+;;; Copyright © 2018, 2019 Clément Lassieur <clement@lassieur.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -54,7 +54,8 @@
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-26)
   #:use-module (ice-9 match)
-  #:export (hydra-jobs))
+  #:export (channel-instance->package
+            hydra-jobs))
 
 ;;; Commentary:
 ;;;
@@ -130,7 +131,8 @@ SYSTEM."
     "aarch64-linux-gnu"
     "powerpc-linux-gnu"
     "i586-pc-gnu"                                 ;aka. GNU/Hurd
-    "i686-w64-mingw32"))
+    "i686-w64-mingw32"
+    "x86_64-w64-mingw32"))
 
 (define %guixsd-supported-systems
   '("x86_64-linux" "i686-linux" "armhf-linux"))
@@ -193,9 +195,11 @@ system.")
 (define channel-build-system
   ;; Build system used to "convert" a channel instance to a package.
   (let* ((build (lambda* (store name inputs
-                                #:key instance #:allow-other-keys)
+                                #:key instance system
+                                #:allow-other-keys)
                   (run-with-store store
-                    (channel-instances->derivation (list instance)))))
+                    (channel-instances->derivation (list instance))
+                    #:system system)))
          (lower (lambda* (name #:key system instance #:allow-other-keys)
                   (bag
                     (name name)
@@ -235,7 +239,7 @@ system.")
             (system-test-value test))))
 
       `((derivation . ,(derivation-file-name drv))
-        (description . ,(format #f "GuixSD '~a' system test"
+        (description . ,(format #f "Guix '~a' system test"
                                 (system-test-name test)))
         (long-description . ,(system-test-description test))
         (license . ,(license-name gpl3+))
@@ -250,7 +254,11 @@ system.")
                                 "." system))))
       (cons name (test->thunk test))))
 
-  (if (member system %guixsd-supported-systems)
+  (if (and (member system %guixsd-supported-systems)
+
+           ;; XXX: Our build farm has too few ARMv7 machines and they are very
+           ;; slow, so skip system tests there.
+           (not (string=? system "armhf-linux")))
       ;; Override the value of 'current-guix' used by system tests.  Using a
       ;; channel instance makes tests that rely on 'current-guix' less
       ;; expensive.  It also makes sure we get a valid Guix package when this
@@ -266,7 +274,7 @@ system.")
     `((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.")
+all its dependencies, and ready to be installed on \"foreign\" distributions.")
       (license . ,(license-name gpl3+))
       (home-page . ,%guix-home-page-url)
       (maintainers . ("bug-guix@gnu.org"))))
@@ -324,8 +332,12 @@ valid."
   "Return the list of packages to build."
   (define (adjust package result)
     (cond ((package-replacement package)
-           (cons* package                         ;build both
-                  (package-replacement package)
+           ;; XXX: If PACKAGE and its replacement have the same name/version,
+           ;; then both Cuirass jobs will have the same name, which
+           ;; effectively means that the second one will be ignored.  Thus,
+           ;; return the replacement first.
+           (cons* (package-replacement package)   ;build both
+                  package
                   result))
           ((package-superseded package)
            result)                                ;don't build it
@@ -362,6 +374,17 @@ valid."
                              load-manifest)
                     manifests))))
 
+(define (find-current-checkout arguments)
+  "Find the first checkout of ARGUMENTS that provided the current file.
+Return #f if no such checkout is found."
+  (let ((current-root
+         (canonicalize-path
+          (string-append (dirname (current-filename)) "/.."))))
+    (find (lambda (argument)
+            (and=> (assq-ref argument 'file-name)
+                   (lambda (name)
+                     (string=? name current-root)))) arguments)))
+
 \f
 ;;;
 ;;; Hydra entry point.
@@ -384,13 +407,8 @@ valid."
       ((? string? str) (call-with-input-string str read))))
 
   (define checkout
-    ;; Extract metadata about the 'guix' checkout.  Its key in ARGUMENTS may
-    ;; vary, so pick up the first one that's neither 'subset' nor 'systems'.
-    (any (match-lambda
-           ((key . value)
-            (and (not (memq key '(systems subset)))
-                 value)))
-         arguments))
+    (or (find-current-checkout arguments)
+        (assq-ref arguments 'superior-guix-checkout)))
 
   (define commit
     (assq-ref checkout 'revision))