From 56fbf2629f10b134e5f6e916e4fc33b0c0658da8 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 15 Jul 2013 23:06:14 +0200 Subject: 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. --- build-aux/check-available-binaries.scm | 52 ++++++++++++++++++++++++++++++++++ 1 file changed, 52 insertions(+) create mode 100644 build-aux/check-available-binaries.scm (limited to 'build-aux/check-available-binaries.scm') 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))) -- cgit 1.4.1