05/07: packages: Remove 'search-bootstrap-binary'.

[guix-commits]

civodul pushed a commit to branch core-updates
in repository guix.

commit 1ba0b1e6ec41afd94a3c5f907b1122204dcb5d9d
Author: Ludovic Courtès <address@hidden>
Date:   Fri Jun 14 21:35:08 2019 +0200

    packages: Remove 'search-bootstrap-binary'.
    
    * gnu/packages.scm (%bootstrap-binaries-path, search-bootstrap-binary):
    Remove.
    * gnu/packages/bootstrap.scm (bootstrap-executable): Export.
    * guix/tests.scm (bootstrap-binary-file, search-bootstrap-binary):
    Export.
    * tests/derivations.scm: Remove (gnu packages) import.
    * tests/grafts.scm: Likewise.
    * tests/guix-daemon.sh: Likewise.
---
 gnu/packages.scm           | 25 +------------------------
 gnu/packages/bootstrap.scm |  1 +
 guix/tests.scm             | 35 +++++++++++++++++++++++++++++++++++
 tests/derivations.scm      |  1 -
 tests/grafts.scm           |  3 +--
 tests/guix-daemon.sh       |  4 ++--
 6 files changed, 40 insertions(+), 29 deletions(-)

diff --git a/gnu/packages.scm b/gnu/packages.scm
index 4742f49..2d7622d 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 c78aaa3..428a89e 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 9df6353..ff31bca 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 c421d09..25ba4c9 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 f85f3c6..e5356de 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 <address@hidden>
+;;; Copyright © 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès 
<address@hidden>
 ;;;
 ;;; 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 ce82cfd..ca46e34 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"