diff options
| -rw-r--r-- | gnu/packages.scm | 25 | ||||
| -rw-r--r-- | gnu/packages/bootstrap.scm | 1 | ||||
| -rw-r--r-- | guix/tests.scm | 35 | ||||
| -rw-r--r-- | tests/derivations.scm | 1 | ||||
| -rw-r--r-- | tests/grafts.scm | 3 | ||||
| -rw-r--r-- | tests/guix-daemon.sh | 4 |
6 files changed, 40 insertions, 29 deletions
diff --git a/gnu/packages.scm b/gnu/packages.scm index 4742f49405..2d7622d397 100644 --- a/gnu/packages.scm +++ b/gnu/packages.scm @@ -46,10 +46,8 @@ #:export (search-patch search-patches search-auxiliary-file - search-bootstrap-binary %patch-path %auxiliary-files-path - %bootstrap-binaries-path %package-module-path %default-package-module-path @@ -75,18 +73,13 @@ ;;; ;;; Code: -;; By default, we store patches, auxiliary files and bootstrap binaries +;; By default, we store patches and auxiliary files ;; alongside Guile modules. This is so that these extra files can be ;; found without requiring a special setup, such as a specific ;; installation directory and an extra environment variable. One ;; advantage of this setup is that everything just works in an ;; auto-compilation setting. -(define %bootstrap-binaries-path - (make-parameter - (map (cut string-append <> "/gnu/packages/bootstrap") - %load-path))) - (define %auxiliary-files-path (make-parameter (map (cut string-append <> "/gnu/packages/aux-files") @@ -108,22 +101,6 @@ FILE-NAME found in %PATCH-PATH." (list (search-patch file-name) ...)) -(define (search-bootstrap-binary file-name system) - "Search the bootstrap binary FILE-NAME for SYSTEM. Raise an error if not -found." - ;; On x86_64 always use the i686 binaries. - (let ((system (match system - ("x86_64-linux" "i686-linux") - (_ system)))) - (or (search-path (%bootstrap-binaries-path) - (string-append system "/" file-name)) - (raise (condition - (&message - (message - (format #f (G_ "could not find bootstrap binary '~a' \ -for system '~a'") - file-name system)))))))) - (define %distro-root-directory ;; Absolute file name of the module hierarchy. Since (gnu packages …) might ;; live in a directory different from (guix), try to get the best match. diff --git a/gnu/packages/bootstrap.scm b/gnu/packages/bootstrap.scm index c78aaa33d0..428a89e927 100644 --- a/gnu/packages/bootstrap.scm +++ b/gnu/packages/bootstrap.scm @@ -43,6 +43,7 @@ package-with-bootstrap-guile glibc-dynamic-linker + bootstrap-executable bootstrap-guile-origin %bootstrap-guile diff --git a/guix/tests.scm b/guix/tests.scm index 9df6353798..ff31bcad44 100644 --- a/guix/tests.scm +++ b/guix/tests.scm @@ -23,14 +23,18 @@ #:use-module (guix packages) #:use-module (guix base32) #:use-module (guix serialization) + #:use-module (guix monads) #:use-module ((guix utils) #:select (substitute-keyword-arguments)) + #:use-module ((guix build utils) #:select (mkdir-p)) #:use-module (gcrypt hash) #:use-module (guix build-system gnu) #:use-module (gnu packages base) #:use-module (gnu packages bootstrap) + #:use-module (srfi srfi-26) #:use-module (srfi srfi-34) #:use-module (srfi srfi-64) #:use-module (rnrs bytevectors) + #:use-module (ice-9 match) #:use-module (ice-9 binary-ports) #:use-module (web uri) #:export (open-connection-for-tests @@ -44,6 +48,8 @@ shebang-too-long? with-environment-variable + search-bootstrap-binary + mock %test-substitute-urls test-assertm @@ -87,6 +93,35 @@ store))) +(define (bootstrap-binary-file program system) + "Return the absolute file name where bootstrap binary PROGRAM for SYSTEM is +stored." + (string-append (dirname (search-path %load-path + "gnu/packages/bootstrap.scm")) + "/bootstrap/" system "/" program)) + +(define (search-bootstrap-binary file-name system) + "Search the bootstrap binary FILE-NAME for SYSTEM. Raise an error if not +found." + ;; Note: Keep bootstrap binaries on the local file system so that the 'guix' + ;; package can provide them as inputs and copy them to the right place. + (let* ((system (match system + ("x86_64-linux" "i686-linux") + (_ system))) + (file (bootstrap-binary-file file-name system))) + (if (file-exists? file) + file + (with-store store + (run-with-store store + (mlet %store-monad ((drv (origin->derivation + (bootstrap-executable file-name system)))) + (mbegin %store-monad + (built-derivations (list drv)) + (begin + (mkdir-p (dirname file)) + (copy-file (derivation->output-path drv) file) + (return file))))))))) + (define (call-with-external-store proc) "Call PROC with an open connection to the external store or #f it there is no external store to talk to." diff --git a/tests/derivations.scm b/tests/derivations.scm index c421d094a4..25ba4c9fa0 100644 --- a/tests/derivations.scm +++ b/tests/derivations.scm @@ -29,7 +29,6 @@ #:use-module (guix tests http) #:use-module ((guix packages) #:select (package-derivation base32)) #:use-module ((guix build utils) #:select (executable-file?)) - #:use-module ((gnu packages) #:select (search-bootstrap-binary)) #:use-module (gnu packages bootstrap) #:use-module ((gnu packages guile) #:select (guile-1.8)) #:use-module (srfi srfi-1) diff --git a/tests/grafts.scm b/tests/grafts.scm index f85f3c6913..e5356decc5 100644 --- a/tests/grafts.scm +++ b/tests/grafts.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -24,7 +24,6 @@ #:use-module (guix utils) #:use-module (guix grafts) #:use-module (guix tests) - #:use-module ((gnu packages) #:select (search-bootstrap-binary)) #:use-module (gnu packages bootstrap) #:use-module (srfi srfi-1) #:use-module (srfi srfi-64) diff --git a/tests/guix-daemon.sh b/tests/guix-daemon.sh index ce82cfd1e6..ca46e34ce9 100644 --- a/tests/guix-daemon.sh +++ b/tests/guix-daemon.sh @@ -141,7 +141,7 @@ daemon_pid=$! GUIX_DAEMON_SOCKET="$socket" \ guile -c ' - (use-modules (guix) (gnu packages) (guix tests)) + (use-modules (guix) (guix tests)) (with-store store (let* ((build (add-text-to-store store "build.sh" @@ -165,7 +165,7 @@ kill "$daemon_pid" # honored. client_code=' - (use-modules (guix) (gnu packages) (guix tests) (srfi srfi-34)) + (use-modules (guix) (guix tests) (srfi srfi-34)) (with-store store (let* ((build (add-text-to-store store "build.sh" |