summaryrefslogtreecommitdiff
path: root/build-aux
diff options
context:
space:
mode:
authorLeo Famulari <leo@famulari.name>2018-09-13 13:32:39 -0400
committerLeo Famulari <leo@famulari.name>2018-09-13 13:32:39 -0400
commitd7639407110a584c18bb362c942eeb0933188c66 (patch)
tree8068d0737e2a65f8f9f7080b7f9fb36a74e58e2c /build-aux
parent36e8185667c41740786d9b2eb3672a0f8b902ed8 (diff)
parent7d1cc612938565d935c53bd7a429f41d1f048dae (diff)
downloadpatches-d7639407110a584c18bb362c942eeb0933188c66.tar
patches-d7639407110a584c18bb362c942eeb0933188c66.tar.gz
Merge branch 'master' into core-updates
Diffstat (limited to 'build-aux')
-rw-r--r--build-aux/build-self.scm20
-rw-r--r--build-aux/hydra/gnu-system.scm35
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)))