From e78d2d8651d5f56afa7d57be78c5cccccebb117a Mon Sep 17 00:00:00 2001 From: Maxime Devos Date: Sun, 18 Apr 2021 20:44:28 +0200 Subject: [PATCH 3/7] build: utils: Make inputs of 'wrap-script' explicit. Previously, 'wrap-script' used (which "guile") to determine where to locate the guile interpreter. But this is incorrect when cross-compiling. When cross-compiling, this would locate the (native) guile interpreter that is in the PATH, while a guile interpreter for the target is required. Remove the optional #:guile argument which is only used in tests and replace it with a required 'inputs' argument and adjust all callers. Write a new test verifying a guile for the target is located, instead of a native guile. * guix/build/utils.scm (wrap-script): Remove optional 'guile' argument. Add required 'inputs' argument. Adjust call to 'update-env' appropriately. Look up "guile" in 'inputs' with 'which'. Also allow 'inputs' to be a string, which is convenient for tests. * tests/build-utils.scm ("wrap-script, simple case", "wrap-script, with encoding declaration") ("wrap-script, raises condition"): Adjust tests to new calling convention. ("wrap-script, searches in inputs"): New test. * gnu/packages/audio.scm (carla)[arguments]<#:phases>{wrap-executables}: Add 'inputs' argument to call to 'wrap-script'. * gnu/packages/bash.scm (bats)[arguments]<#:builder>: Likewise. * gnu/packages/bioinformatics.scm (proteinortho)[arguments]<#:phases>{wrap-programs}: Likewise. (prinseq)[arguments]<#:phases>{install}: Likewise. (gess)[arguments]<#:phases>{install}: Likewise. (nanopolish)[arguments]<#:phases>{wrap-programs}: Likewise. * gnu/packages/mail.scm (sieve-connect)[arguments]<#:phases>{wrap-program}: Likewise. * gnu/packages/vpn.scm (vpnc-scripts)[arguments]<#:phases>{wrap-scripts}: Likewise. * gnu/packages/xdisorg.scm (clipmenu)[arguments]<#:phases>{wrap-script}: Likewise. --- gnu/packages/audio.scm | 4 +-- gnu/packages/bash.scm | 2 +- gnu/packages/bioinformatics.scm | 13 ++++++---- gnu/packages/mail.scm | 2 +- gnu/packages/vpn.scm | 2 +- gnu/packages/xdisorg.scm | 2 +- guix/build/utils.scm | 14 ++++++----- tests/build-utils.scm | 43 ++++++++++++++++++++++++++++++--- 8 files changed, 62 insertions(+), 20 deletions(-) diff --git a/gnu/packages/audio.scm b/gnu/packages/audio.scm index 30e38cef70..50627cc3e7 100644 --- a/gnu/packages/audio.scm +++ b/gnu/packages/audio.scm @@ -4712,9 +4712,9 @@ as is the case with audio plugins.") (chmod (string-append out "/share/carla/carla") #o555) #t))) (add-after 'install 'wrap-executables - (lambda* (#:key outputs #:allow-other-keys) + (lambda* (#:key inputs outputs #:allow-other-keys) (let ((out (assoc-ref outputs "out"))) - (wrap-script (string-append out "/bin/carla") + (wrap-script (string-append out "/bin/carla") inputs `("GUIX_PYTHONPATH" ":" prefix (,(getenv "GUIX_PYTHONPATH")))) #t)))))) (inputs diff --git a/gnu/packages/bash.scm b/gnu/packages/bash.scm index ed2931fd97..51013b5bc1 100644 --- a/gnu/packages/bash.scm +++ b/gnu/packages/bash.scm @@ -408,7 +408,7 @@ capturing.") line))) ;; Install phase (invoke "./install.sh" %output) - (wrap-script (string-append %output "/bin/bats") + (wrap-script (string-append %output "/bin/bats") %build-inputs (list "PATH" 'prefix (string-split (getenv "PATH") #\:)))))) (build-system trivial-build-system) diff --git a/gnu/packages/bioinformatics.scm b/gnu/packages/bioinformatics.scm index 313c70784a..2ca56d3962 100644 --- a/gnu/packages/bioinformatics.scm +++ b/gnu/packages/bioinformatics.scm @@ -5395,7 +5395,8 @@ predicts the locations of structural units in the sequences.") (let ((path (getenv "PATH")) (out (assoc-ref outputs "out"))) (for-each (lambda (script) - (wrap-script script `("PATH" ":" prefix (,path)))) + (wrap-script script inputs + `("PATH" ":" prefix (,path)))) (cons (string-append out "/bin/proteinortho") (find-files out "\\.(pl|py)$")))) #t))))) @@ -7461,13 +7462,14 @@ experience substantial biological insertions and deletions.") (delete 'configure) (delete 'build) (replace 'install - (lambda* (#:key outputs #:allow-other-keys) + (lambda* (#:key inputs outputs #:allow-other-keys) (let* ((out (assoc-ref outputs "out")) (bin (string-append out "/bin"))) (for-each (lambda (file) (chmod file #o555) (install-file file bin) (wrap-script (string-append bin "/" (basename file)) + inputs `("PERL5LIB" ":" prefix (,(getenv "PERL5LIB"))))) (find-files "." "prinseq.*.pl")))))))) @@ -10115,7 +10117,7 @@ import matplotlib matplotlib.use('Agg') " line))) ;; Make sure GESS has all modules in its path - (wrap-script (string-append target "GESS.py") + (wrap-script (string-append target "GESS.py") inputs `("GUIX_PYTHONPATH" ":" = (,target ,(getenv "GUIX_PYTHONPATH")))) (mkdir-p bin) (symlink (string-append target "GESS.py") @@ -13456,7 +13458,7 @@ choosing which reads pass the filter.") (find-files "scripts" ".*")) #t))) (add-after 'install 'wrap-programs - (lambda* (#:key outputs #:allow-other-keys) + (lambda* (#:key inputs outputs #:allow-other-keys) (let ((pythonpath (getenv "GUIX_PYTHONPATH")) (perl5lib (getenv "PERL5LIB")) (scripts (string-append (assoc-ref outputs "out") @@ -13465,7 +13467,8 @@ choosing which reads pass the filter.") (wrap-program file `("GUIX_PYTHONPATH" ":" prefix (,pythonpath)))) (find-files scripts "\\.py")) (for-each (lambda (file) - (wrap-script file `("PERL5LIB" ":" prefix (,perl5lib)))) + (wrap-script file inputs + `("PERL5LIB" ":" prefix (,perl5lib)))) (find-files scripts "\\.pl")))))))) (inputs `(("guile" ,guile-3.0) ; for wrappers diff --git a/gnu/packages/mail.scm b/gnu/packages/mail.scm index 35584c497a..39cf827d84 100644 --- a/gnu/packages/mail.scm +++ b/gnu/packages/mail.scm @@ -2924,7 +2924,7 @@ transfer protocols.") (lambda* (#:key inputs outputs #:allow-other-keys) (let ((out (assoc-ref outputs "out")) (path (getenv "PERL5LIB"))) - (wrap-script (string-append out "/bin/sieve-connect") + (wrap-script (string-append out "/bin/sieve-connect") inputs `("PERL5LIB" ":" = (,path))) #t)))))) (inputs diff --git a/gnu/packages/vpn.scm b/gnu/packages/vpn.scm index adb48b1b97..398d4b040b 100644 --- a/gnu/packages/vpn.scm +++ b/gnu/packages/vpn.scm @@ -195,7 +195,7 @@ Only \"Universal TUN/TAP device driver support\" is needed in the kernel.") (let ((out (assoc-ref outputs "out"))) (for-each (lambda (script) - (wrap-script (string-append out "/etc/vpnc/" script) + (wrap-script (string-append out "/etc/vpnc/" script) inputs `("PATH" ":" prefix ,(map (lambda (name) (let ((input (assoc-ref inputs name))) diff --git a/gnu/packages/xdisorg.scm b/gnu/packages/xdisorg.scm index 4202a7168e..76b0156678 100644 --- a/gnu/packages/xdisorg.scm +++ b/gnu/packages/xdisorg.scm @@ -2550,7 +2550,7 @@ tools to complement clipnotify.") (xsel (assoc-ref inputs "xsel"))) (for-each (lambda (prog) - (wrap-script (string-append out "/bin/" prog) + (wrap-script (string-append out "/bin/" prog) inputs `("PATH" ":" prefix ,(map (lambda (dir) (string-append dir "/bin")) diff --git a/guix/build/utils.scm b/guix/build/utils.scm index 5eb9f9580b..b725237ce6 100644 --- a/guix/build/utils.scm +++ b/guix/build/utils.scm @@ -1353,7 +1353,7 @@ with definitions for VARS." (coding-line-regex (make-regexp ".*#.*coding[=:][[:space:]]*([-a-zA-Z_0-9.]+)"))) - (lambda* (prog #:key (guile (which "guile")) #:rest vars) + (lambda* (prog inputs #:rest vars) "Wrap the script PROG such that VARS are set first. The format of VARS is the same as in the WRAP-PROGRAM procedure. This procedure differs from WRAP-PROGRAM in that it does not create a separate shell script. Instead, @@ -1413,12 +1413,14 @@ not supported." #\\-~s #\\-~s " - guile + ;; This is convenient for tests, but should + ;; not be used in real package definitions. + ;; See tests/build-utils.scm. + (if (string? inputs) + inputs + (which "guile" inputs)) (or coding-line "Guix wrapper") - (cons 'begin (map update-env - (match vars - ((#:guile _ . vars) vars) - (_ vars)))) + (cons 'begin (map update-env vars)) `(let ((cl (command-line))) (apply execl ,interpreter (car cl) diff --git a/tests/build-utils.scm b/tests/build-utils.scm index 636fa40c47..620cddbbfc 100644 --- a/tests/build-utils.scm +++ b/tests/build-utils.scm @@ -178,7 +178,7 @@ echo hello world")) (lambda (port) (display script-contents port))) (chmod script-file-name #o777) - (wrap-script script-file-name + (wrap-script script-file-name (which "guile") `("GUIX_FOO" prefix ("/some/path" "/some/other/path"))) (let ((str (call-with-input-file script-file-name get-string-all))) @@ -220,7 +220,7 @@ print('hello world')")) (chmod script-file-name #o777) (wrap-script script-file-name - #:guile "MYGUILE" + "MYGUILE" `("GUIX_FOO" prefix ("/some/path" "/some/other/path"))) (let ((str (call-with-input-file script-file-name get-string-all))) @@ -238,11 +238,48 @@ print('hello world')")) (chmod script-file-name #o777) (guard (c ((wrap-error? c) #t)) (wrap-script script-file-name - #:guile "MYGUILE" + "MYGUILE" `("GUIX_FOO" prefix ("/some/path" "/some/other/path"))) #f))))) +;; for cross-compilation purposes, it is important 'wrap-script' +;; looks in the INPUTS, and doesn't simply use the native guile. +(test-assert "wrap-script, searches in inputs" + (call-with-temporary-directory + (lambda (directory) + (let* ((guile-bindir (string-append directory "/bin")) + (guile-binary (string-append guile-bindir "/guile")) + (inputs `(("guile" . ,directory))) + (script-file-name (string-append directory "/foo")) + (script-contents + "#!/anything/cabbage-bash-1.2.3/bin/sh + +echo hello world")) + (mkdir-p guile-bindir) + (call-with-output-file guile-binary + (lambda (port) + (display "This pretends to be guile" port))) + (make-file-writable guile-binary) + (call-with-output-file script-file-name + (lambda (port) + (display script-contents port))) + (wrap-script script-file-name inputs) + (string=? (format #f + "#!~a --no-auto-compile +#!#; Guix wrapper +#\\-(begin) +#\\-~s +#!/anything/cabbage-bash-1.2.3/bin/sh + +echo hello world" + guile-binary + '(let ((cl (command-line))) + (apply execl "/anything/cabbage-bash-1.2.3/bin/sh" + (car cl) (cons (car cl) + (append '("") cl)))))) + (call-with-input-file script-file-name get-string-all))))) + (test-equal "substitute*, text contains a NUL byte, UTF-8" "c\0d" (with-fluids ((%default-port-encoding "UTF-8") -- 2.31.1