Merge branch 'master' into core-updates

2 files changed, 54 insertions, 1 deletions

diff --git a/build-aux/build-self.scm b/build-aux/build-self.scm
index 9e8cc90067..5b281c3bc9 100644
--- a/build-aux/build-self.scm
+++ b/build-aux/build-self.scm
@@ -25,6 +25,8 @@
   #:use-module (guix build-system gnu)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-19)
+  #:use-module (srfi srfi-34)
+  #:use-module (srfi srfi-35)
   #:use-module (rnrs io ports)
   #:use-module (ice-9 match)
   #:use-module (ice-9 popen)
@@ -263,6 +265,9 @@ interface (FFI) of Guile.")
                  #~(define-module (gcrypt hash)
                      #:export (sha1 sha256))))
 
+  (define fake-git
+    (scheme-file "git.scm" #~(define-module (git))))
+
   (with-imported-modules `(((guix config)
                             => ,(make-config.scm))
 
@@ -272,6 +277,11 @@ interface (FFI) of Guile.")
                            ;; adjust %LOAD-PATH later on.
                            ((gcrypt hash) => ,fake-gcrypt-hash)
 
+                           ;; (guix git-download) depends on (git) but only
+                           ;; for peripheral functionality.  Provide a dummy
+                           ;; (git) to placate it.
+                           ((git) => ,fake-git)
+
                            ,@(source-module-closure `((guix store)
                                                       (guix self)
                                                       (guix derivations)
@@ -417,7 +427,15 @@ files."
            ;; Unsupported PULL-VERSION.
            (return #f))
           ((? string? str)
-           (error "invalid build result" (list build str))))))))
+           (raise (condition
+                   (&message
+                    (message (format #f "You found a bug: the program '~a'
+failed to compute the derivation for Guix (version: ~s; system: ~s;
+host version: ~s; pull-version: ~s).
+Please report it by email to <~a>.~%"
+                                     (derivation->output-path build)
+                                     version system %guix-version pull-version
+                                     %guix-bug-report-address)))))))))))
 
 ;; This file is loaded by 'guix pull'; return it the build procedure.
 build
diff --git a/build-aux/hydra/gnu-system.scm b/build-aux/hydra/gnu-system.scm
index b1554ced4c..7234e2d0e8 100644
--- a/build-aux/hydra/gnu-system.scm
+++ b/build-aux/hydra/gnu-system.scm
@@ -1,6 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2017 Jan Nieuwenhuizen <janneke@gnu.org>
+;;; Copyright © 2018 Clément Lassieur <clement@lassieur.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -56,6 +57,7 @@
              (guix packages)
              (guix derivations)
              (guix monads)
+             (guix ui)
              ((guix licenses) #:select (gpl3+))
              ((guix utils) #:select (%current-system))
              ((guix scripts system) #:select (read-operating-system))
@@ -311,6 +313,30 @@ valid."
                           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))))
+
+  (parameterize ((%graft? #f))
+    (delete-duplicates!
+     (map manifest-entry-item
+          (append-map (compose manifest-entries
+                               load-manifest)
+                      manifests)))))
+
 
 ;;;
 ;;; Hydra entry point.
@@ -323,6 +349,7 @@ valid."
       ("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
@@ -419,6 +446,14 @@ valid."
                                                  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)))