Merge branch 'master' into staging

[jackhill/guix/guix.git] / build-aux / hydra / gnu-system.scm

diff --git a/build-aux/hydra/gnu-system.scm b/build-aux/hydra/gnu-system.scm
index a84cdeb..b1faa22 100644 (file)
--- a/build-aux/hydra/gnu-system.scm
+++ b/build-aux/hydra/gnu-system.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -39,12 +39,15 @@
 (use-modules (guix config)
              (guix store)
              (guix grafts)
+             (guix profiles)
              (guix packages)
              (guix derivations)
              (guix monads)
              ((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 packages)
              (gnu packages gcc)
              (gnu packages base)
@@ -54,7 +57,6 @@
              (gnu packages compression)
              (gnu packages multiprecision)
              (gnu packages make-bootstrap)
-             (gnu packages commencement)
              (gnu packages package-management)
              (gnu system)
              (gnu system vm)
@@ -109,10 +111,10 @@ SYSTEM."
   ;; 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 zlib gzip xz
+        gawk gnu-gettext hello guile-2.0 guile-2.2 zlib gzip xz
         %bootstrap-binaries-tarball
         %binutils-bootstrap-tarball
-        %glibc-bootstrap-tarball
+        (%glibc-bootstrap-tarball)
         %gcc-bootstrap-tarball
         %guile-bootstrap-tarball
         %bootstrap-tarballs))
@@ -122,13 +124,12 @@ SYSTEM."
 
 (define %cross-targets
   '("mips64el-linux-gnu"
-    "mips64el-linux-gnuabi64"))
-
-(define (demo-os)
-  "Return the \"demo\" 'operating-system' structure."
-  (let* ((dir  (dirname (assoc-ref (current-source-location) 'filename)))
-         (file (string-append dir "/demo-os.scm")))
-    (read-operating-system file)))
+    "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"))
@@ -155,14 +156,7 @@ system.")
     (expt 2 20))
 
   (if (member system %guixsd-supported-systems)
-      (list (->job 'qemu-image
-                   (run-with-store store
-                     (mbegin %store-monad
-                       (set-guile-for-build (default-guile))
-                       (system-qemu-image (demo-os)
-                                          #:disk-image-size
-                                          (* 1400 MiB))))) ; 1.4 GiB
-            (->job 'usb-image
+      (list (->job 'usb-image
                    (run-with-store store
                      (mbegin %store-monad
                        (set-guile-for-build (default-guile))
@@ -224,7 +218,12 @@ all its dependencies, and ready to be installed on non-GuixSD distributions.")
                (run-with-store store
                  (mbegin %store-monad
                    (set-guile-for-build (default-guile))
-                   (self-contained-tarball))
+                   (>>= (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
@@ -239,7 +238,7 @@ all its dependencies, and ready to be installed on non-GuixSD distributions.")
                         (match (package-transitive-inputs package)
                           (((_ inputs _ ...) ...)
                            inputs))))
-                      %final-inputs))))
+                      (%final-inputs)))))
     (lambda (store package system)
       "Return a job for PACKAGE on SYSTEM, or #f if this combination is not
 valid."
@@ -268,25 +267,34 @@ valid."
       ;; 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-suffix? "64" target)))
+           (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'.
-      (string-contains target system))
+      (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.
+      (and (string-contains target "mingw")
+           (not (string=? "x86_64-linux" system))))
 
-    (define (either proc1 proc2)
+    (define (either proc1 proc2 proc3)
       (lambda (x)
-        (or (proc1 x) (proc2 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?) %cross-targets)))
+                (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))
@@ -297,11 +305,14 @@ valid."
                      ;; Build everything, including replacements.
                      (let ((all (fold-packages
                                  (lambda (package result)
-                                   (if (package-replacement package)
-                                       (cons* package
-                                              (package-replacement package)
-                                              result)
-                                       (cons package result)))
+                                   (cond ((package-replacement package)
+                                          (cons* package
+                                                 (package-replacement package)
+                                                 result))
+                                         ((package-superseded package)
+                                          result) ;don't build it
+                                         (else
+                                          (cons package result))))
                                  '()))
                            (job (lambda (package)
                                   (package->job store package