From 56fbf2629f10b134e5f6e916e4fc33b0c0658da8 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Mon, 15 Jul 2013 23:06:14 +0200 Subject: [PATCH] build: Check for the availability of binaries upon "distcheck". * build-aux/check-available-binaries.scm: New file. * Makefile.am (EXTRA_DIST): Add it. (distcheck-hook, assert-binaries-available): New target. --- Makefile.am | 10 ++++- build-aux/check-available-binaries.scm | 52 ++++++++++++++++++++++++++ 2 files changed, 61 insertions(+), 1 deletion(-) create mode 100644 build-aux/check-available-binaries.scm diff --git a/Makefile.am b/Makefile.am index dd087bf442..ecda21c77f 100644 --- a/Makefile.am +++ b/Makefile.am @@ -129,6 +129,7 @@ EXTRA_DIST = \ TODO \ .dir-locals.el \ build-aux/hydra/gnu-system.scm \ + build-aux/check-available-binaries.scm \ build-aux/download.scm \ build-aux/list-packages.scm \ build-aux/sync-synopses.scm \ @@ -211,6 +212,7 @@ AM_DISTCHECK_CONFIGURE_FLAGS = \ --enable-daemon dist-hook: sync-synopses gen-ChangeLog assert-no-store-file-names +distcheck-hook: assert-binaries-available sync-synopses: -$(top_builddir)/pre-inst-env $(GUILE) \ @@ -233,4 +235,10 @@ assert-no-store-file-names: exit 1 ; \ fi -.PHONY: sync-synopses gen-ChangeLog assert-no-store-file-names +# Make sure hydra.gnu.org has the important binaries. +assert-binaries-available: + $(top_builddir)/pre-inst-env "$(GUILE)" \ + "$(top_srcdir)/build-aux/check-available-binaries.scm" + +.PHONY: sync-synopses gen-ChangeLog +.PHONY: assert-no-store-file-names assert-binaries-available diff --git a/build-aux/check-available-binaries.scm b/build-aux/check-available-binaries.scm new file mode 100644 index 0000000000..5599e5e7b6 --- /dev/null +++ b/build-aux/check-available-binaries.scm @@ -0,0 +1,52 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2013 Ludovic Courtès +;;; +;;; 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 . + +;;; +;;; Check whether important binaries are available at hydra.gnu.org. +;;; + +(use-modules (guix store) + (guix packages) + (guix derivations) + (gnu packages emacs) + (gnu packages make-bootstrap) + (srfi srfi-1) + (srfi srfi-26)) + +(let* ((store (open-connection)) + (native (map (cut package-derivation store <>) + (list %bootstrap-tarballs emacs))) + (cross (map (cut package-cross-derivation store + %bootstrap-tarballs <>) + '("mips64el-linux-gnuabi64"))) + (total (append native cross))) + (define (warn proc) + (lambda (drv) + (or (proc drv) + (begin + (format (current-error-port) "~a is not substitutable~%" + drv) + #f)))) + + (let ((result (every (compose (warn (cut has-substitutes? store <>)) + derivation-path->output-path) + total))) + (when result + (format (current-error-port) "~a packages found substitutable~%" + (length total))) + (exit result)))