From 42e7cf4ca6e4d6e1cd31c2807f608275a5ca759a Mon Sep 17 00:00:00 2001 From: Maxime Devos Date: Sun, 18 Apr 2021 12:45:13 +0200 Subject: [PATCH 1/7] build: Add argument to which for specifying where to search. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit The procedure ‘which’ from (guix build utils) is used for two different purposes: 1. for finding the absolute file name of a binary that needs to run during the build process 2. for finding the absolute file name of a binary, for the target system (as in --target=TARGET), e.g. for substituting sh->/gnu/store/.../bin/sh, python->/gnu/store/.../bin/python. When compiling natively (SYSTEM=TARGET modulo nix/autotools differences), this is perfectly fine. However, when cross-compiling, there is a problem. "which" looks in $PATH for binaries. That's good for purpose (1), but incorrect for (2), as the $PATH contains binaries from native-inputs instead of inputs. This commit adds an optional 'inputs' argument. When it is present, 'which' will look in the bin and sbin subdirectories of the directories in the 'inputs' alist. * guix/build/utils.scm (which): Add optional 'inputs' argument * tests/build/utils.scm ("which, inputs in /bin", "which, inputs in /sbin") ("which, empty inputs", "which, using $PATH"): Test both old and new functionality of this procedure. (touch): Define procedure. (with-artificial-inputs): Define macro. --- guix/build/utils.scm | 16 +++++++++---- tests/build-utils.scm | 53 +++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 65 insertions(+), 4 deletions(-) diff --git a/guix/build/utils.scm b/guix/build/utils.scm index 6c37021673..5eb9f9580b 100644 --- a/guix/build/utils.scm +++ b/guix/build/utils.scm @@ -7,6 +7,7 @@ ;;; Copyright © 2018, 2019 Ricardo Wurmus ;;; Copyright © 2020 Efraim Flashner ;;; Copyright © 2020, 2021 Maxim Cournoyer +;;; Copyright © 2021 Maxime Devos ;;; ;;; This file is part of GNU Guix. ;;; @@ -607,10 +608,17 @@ denoting file names to look for under the directories designated by FILES: (format #t "environment variable `~a' set to `~a'~%" env-var value))))) -(define (which program) - "Return the complete file name for PROGRAM as found in $PATH, or #f if -PROGRAM could not be found." - (search-path (search-path-as-string->list (getenv "PATH")) +(define* (which program #:optional inputs) + "Return the complete file name for PROGRAM as found in $PATH, or #false if +PROGRAM could not be found. If INPUTS is not #false, instead look in the +/bin and /sbin subdirectories of INPUTS. INPUTS is an alist; its keys +are ignored." + (define (input->path input) + `(,(string-append (cdr input) "/bin") + ,(string-append (cdr input) "/sbin"))) + (search-path (if inputs + (append-map input->path inputs) + (search-path-as-string->list (getenv "PATH"))) program)) diff --git a/tests/build-utils.scm b/tests/build-utils.scm index 31be7ff80f..636fa40c47 100644 --- a/tests/build-utils.scm +++ b/tests/build-utils.scm @@ -2,6 +2,7 @@ ;;; Copyright © 2012, 2015, 2016, 2019, 2020 Ludovic Courtès ;;; Copyright © 2019 Ricardo Wurmus ;;; Copyright © 2021 Maxim Cournoyer +;;; Copyright © 2021 Maxime Devos ;;; ;;; This file is part of GNU Guix. ;;; @@ -263,4 +264,56 @@ print('hello world')")) (lambda _ (get-string-all (current-input-port)))))))) +(define (touch file) + (call-with-output-file file (const #t))) + +(define-syntax-rule (with-artificial-inputs inputs + ((x key relative-name) ...) + exp exp* ...) + "For the duration of EXP EXP* ..., create a temporary directory. +In this directory, the files RELATIVE-NAME ... are created, and +X ... are bound to their absolute name. INPUTS is bound to +an alist with as keys KEY ... and as values the absolute file names +of the grandparents of RELATIVE-NAME ... ." + (call-with-temporary-directory + (lambda (tempdir) + (let* ((x (in-vicinity tempdir relative-name)) + ... + (inputs `((key . ,(dirname (dirname x))) ...))) + (for-each (compose mkdir-p dirname) (list x ...)) + (for-each touch (list x ...)) + exp exp* ...)))) + +(test-equal "which, inputs in /bin" + '(#t #t) + (with-artificial-inputs inputs + ((x "package-x" "x-1.0/bin/x") + (y "package-y" "y-1.0/bin/y")) + (list (string=? x (which "x" inputs)) + (string=? y (which "y" inputs))))) + +(test-equal "which, inputs in /sbin" + '(#t #t) + (with-artificial-inputs inputs + ((x "package-x" "x-1.0/sbin/x") + (y "package-y" "y-1.0/sbin/y")) + (list (string=? x (which "x" inputs)) + (string=? y (which "y" inputs))))) + +(test-equal "which, empty inputs" + #f + (which "ls" '())) + +(test-assert "which, using $PATH" + (call-with-temporary-directory + (lambda (dirname) + (touch (in-vicinity dirname "ls")) + (with-environment-variable "PATH" dirname + (lambda () + (string=? (in-vicinity dirname "ls") (which "ls"))))))) + (test-end) + +;;; Local Variables: +;;; eval: (put 'with-artificial-inputs 'scheme-indent-function 1) +;;; End: -- 2.31.1