diff options
Diffstat (limited to 'tests/build-utils.scm')
| -rw-r--r-- | tests/build-utils.scm | 104 |
1 files changed, 98 insertions, 6 deletions
diff --git a/tests/build-utils.scm b/tests/build-utils.scm index 654b480ed9..7f4f12ccc7 100644 --- a/tests/build-utils.scm +++ b/tests/build-utils.scm @@ -1,6 +1,9 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2012, 2015, 2016, 2019, 2020 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2019 Ricardo Wurmus <rekado@elephly.net> +;;; Copyright © 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com> +;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be> +;;; Copyright © 2021 Brendan Tildesley <mail@brendan.scot> ;;; ;;; This file is part of GNU Guix. ;;; @@ -18,7 +21,7 @@ ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. -(define-module (test-build-utils) +(define-module (test build-utils) #:use-module (guix tests) #:use-module (guix build utils) #:use-module ((guix utils) @@ -165,9 +168,7 @@ echo hello world")) "/some/path:/some/other/path")))) '(let ((cl (command-line))) (apply execl "/anything/cabbage-bash-1.2.3/bin/sh" - (car cl) - (cons (car cl) - (append '("") cl))))) + (car cl) (append (quote ()) cl)))) script-contents) (call-with-temporary-directory (lambda (directory) @@ -206,8 +207,7 @@ print('hello world')")) `(let ((cl (command-line))) (apply execl "/anything/cabbage-bash-1.2.3/bin/python3" (car cl) - (cons (car cl) - (append '("" "-and" "-args") cl))))) + (append '("-and" "-args") cl)))) script-contents) (call-with-temporary-directory (lambda (directory) @@ -241,4 +241,96 @@ print('hello world')")) "/some/other/path"))) #f))))) +(define (arg-test bash-args) + (call-with-temporary-directory + (lambda (directory) + (let ((script-file-name (string-append directory "/bash-test.sh"))) + (call-with-output-file script-file-name + (lambda (port) + (display (string-append "\ +#!" (which "bash") bash-args " +echo \"$#$0$*${A}\"") + port))) + + (display "Unwrapped script contents:\n") + (call-with-input-file script-file-name + (lambda (port) (display (get-string-all port)))) + (newline) (newline) + (chmod script-file-name #o777) + (setenv "A" "A") + (let* ((run-script (lambda _ + (open-pipe* + OPEN_READ + script-file-name "1" "2" "3 3" "4"))) + (pipe (run-script)) + (unwrapped-output (get-string-all pipe))) + (close-pipe pipe) + + (wrap-script script-file-name `("A" = ("A\nA"))) + + (display "Wrapped script contents:\n") + (call-with-input-file script-file-name + (lambda (port) (display (get-string-all port)))) + (newline) (newline) + + (let* ((pipe (run-script)) + (wrapped-output (get-string-all pipe))) + (close-pipe pipe) + (display "./bash-test.sh 1 2 3\\ 3 4 # Output:\n") + (display unwrapped-output) (newline) + (display "./bash-test.sh 1 2 3\\ 3 4 # Output (wrapped):\n") + (display wrapped-output) (newline) + (string=? (string-append unwrapped-output "A\n") + wrapped-output))))))) + +(test-assert "wrap-script, argument handling" + (arg-test "")) + +(test-assert "wrap-script, argument handling, bash --norc" + (arg-test " --norc")) + +(test-equal "substitute*, text contains a NUL byte, UTF-8" + "c\0d" + (with-fluids ((%default-port-encoding "UTF-8") + (%default-port-conversion-strategy 'error)) + ;; The GNU libc is locale sensitive. Depending on the value of LANG, the + ;; test could fail with "string contains #\\nul character: ~S" or "cannot + ;; convert wide string to output locale". + (setlocale LC_ALL "en_US.UTF-8") + (call-with-temporary-output-file + (lambda (file port) + (format port "a\0b") + (flush-output-port port) + + (substitute* file + (("a") "c") + (("b") "d")) + + (with-input-from-file file + (lambda _ + (get-string-all (current-input-port)))))))) + +(test-equal "search-input-file: exception if not found" + `((path) + (file . "does-not-exist")) + (guard (e ((search-error? e) + `((path . ,(search-error-path e)) + (file . ,(search-error-file e))))) + (search-input-file '() "does-not-exist"))) + +(test-equal "search-input-file: can find if existent" + (which "guile") + (search-input-file + `(("guile/bin" . ,(dirname (which "guile")))) + "guile")) + +(test-equal "search-input-file: can search in multiple directories" + (which "guile") + (call-with-temporary-directory + (lambda (directory) + (search-input-file + `(("irrelevant" . ,directory) + ("guile/bin" . ,(dirname (which "guile")))) + "guile")))) + (test-end) |