~ruther/guix-local

81f61c17c5a46e0ca720395da07d2c96d13e1bcf — Ludovic Courtès 11 years ago c4e5235
build: Add 'assert-final-inputs-self-contained' rule.

* build-aux/check-final-inputs-self-contained.scm: New file.
* Makefile.am (EXTRA_DIST): Add it.
  (assert-final-inputs-self-contained): New target.
  (distcheck-hook): Depend on it.
2 files changed, 112 insertions(+), 22 deletions(-)

M Makefile.am
A build-aux/check-final-inputs-self-contained.scm
M Makefile.am => Makefile.am +29 -22
@@ 186,27 186,28 @@ tests/guix-gc.log:							\
# Public key used to sign substitutes from hydra.gnu.org.
dist_pkgdata_DATA = hydra.gnu.org.pub

EXTRA_DIST =					\
  HACKING					\
  ROADMAP					\
  TODO						\
  .dir-locals.el				\
  build-aux/hydra/gnu-system.scm		\
  build-aux/hydra/demo-os.scm			\
  build-aux/hydra/guix.scm			\
  build-aux/check-available-binaries.scm	\
  build-aux/download.scm			\
  build-aux/list-packages.scm			\
  build-aux/sync-descriptions.scm		\
  srfi/srfi-37.scm.in				\
  srfi/srfi-64.scm				\
  srfi/srfi-64.upstream.scm			\
  tests/test.drv				\
  tests/signing-key.pub				\
  tests/signing-key.sec				\
  build-aux/config.rpath			\
  bootstrap					\
  release.nix					\
EXTRA_DIST =						\
  HACKING						\
  ROADMAP						\
  TODO							\
  .dir-locals.el					\
  build-aux/hydra/gnu-system.scm			\
  build-aux/hydra/demo-os.scm				\
  build-aux/hydra/guix.scm				\
  build-aux/check-available-binaries.scm		\
  build-aux/check-final-inputs-self-contained.scm	\
  build-aux/download.scm				\
  build-aux/list-packages.scm				\
  build-aux/sync-descriptions.scm			\
  srfi/srfi-37.scm.in					\
  srfi/srfi-64.scm					\
  srfi/srfi-64.upstream.scm				\
  tests/test.drv					\
  tests/signing-key.pub					\
  tests/signing-key.sec					\
  build-aux/config.rpath				\
  bootstrap						\
  release.nix						\
  $(TESTS)

if !BUILD_DAEMON_OFFLOAD


@@ 264,7 265,7 @@ AM_DISTCHECK_CONFIGURE_FLAGS =			\
  --enable-daemon

dist-hook: sync-descriptions gen-ChangeLog assert-no-store-file-names
distcheck-hook: assert-binaries-available
distcheck-hook: assert-binaries-available assert-final-inputs-self-contained

sync-descriptions:
	-$(top_builddir)/pre-inst-env $(GUILE)		\


@@ 292,5 293,11 @@ assert-binaries-available:
	$(top_builddir)/pre-inst-env "$(GUILE)"				\
	  "$(top_srcdir)/build-aux/check-available-binaries.scm"

# Make sure the final inputs don't refer to bootstrap tools.
assert-final-inputs-self-contained:
	$(top_builddir)/pre-inst-env "$(GUILE)"				\
	  "$(top_srcdir)/build-aux/check-final-inputs-self-contained.scm"

.PHONY: sync-descriptions gen-ChangeLog clean-go
.PHONY: assert-no-store-file-names assert-binaries-available
.PHONY: assert-final-inputs-self-contained

A build-aux/check-final-inputs-self-contained.scm => build-aux/check-final-inputs-self-contained.scm +83 -0
@@ 0,0 1,83 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014 Ludovic Courtès <ludo@gnu.org>
;;;
;;; 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 <http://www.gnu.org/licenses/>.

;;;
;;; Check whether important binaries are available at hydra.gnu.org.
;;;

(use-modules (guix store)
             (guix packages)
             (guix derivations)
             (guix ui)
             (gnu packages base)
             (ice-9 match)
             (srfi srfi-1)
             (srfi srfi-26))

(define %supported-systems
  '("x86_64-linux" "i686-linux"))

(define (final-inputs store system)
  "Return the list of outputs directories of the final inputs for SYSTEM."
  (append-map (match-lambda
               ((name package)
                (let ((drv (package-derivation store package system)))
                  ;; Libc's 'debug' output refers to gcc-cross-boot0, but it's
                  ;; hard to avoid, so we tolerate it.  This should be the
                  ;; only exception.
                  (filter-map (match-lambda
                               (("debug" . directory)
                                (if (string=? "glibc" (package-name package))
                                    #f
                                    directory))
                               ((_ . directory) directory))
                              (derivation->output-paths drv)))))
              %final-inputs))

(define (assert-valid-substitute substitute)
  "Make sure SUBSTITUTE does not refer to any bootstrap inputs, and bail out
if it does."
  (let ((references (substitutable-references substitute)))
    (when (any (cut string-contains <> "boot") references)
      (leave (_ "'~a' refers to bootstrap inputs: ~s~%")
             (substitutable-path substitute) references))))

(define (test-final-inputs store system)
  "Check whether the final inputs for SYSTEM are clean---i.e., they don't
refer to the bootstrap tools."
  (format #t "checking final inputs for '~a'...~%" system)
  (let* ((inputs    (final-inputs store system))
         (available (substitutable-path-info store inputs)))
    (for-each (lambda (dir)
                (unless (find (lambda (substitute)
                                (string=? (substitutable-path substitute)
                                          dir))
                              available)
                  (leave (_ "~a (system: ~a) has no substitute~%")
                         dir system)))
              inputs)

    (for-each assert-valid-substitute available)))

;; Entry point.
(with-store store
  (set-build-options store #:use-substitutes? #t)

  (for-each (cut test-final-inputs store <>)
            %supported-systems))