diff options
Diffstat (limited to 'tests/build-utils.scm')
| -rw-r--r-- | tests/build-utils.scm | 52 |
1 files changed, 37 insertions, 15 deletions
diff --git a/tests/build-utils.scm b/tests/build-utils.scm index 1c9084514d..5678bb6a22 100644 --- a/tests/build-utils.scm +++ b/tests/build-utils.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2015, 2016 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2012, 2015, 2016, 2019 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2019 Ricardo Wurmus <rekado@elephly.net> ;;; ;;; This file is part of GNU Guix. @@ -21,11 +21,14 @@ (define-module (test-build-utils) #:use-module (guix tests) #:use-module (guix build utils) + #:use-module ((gnu build bootloader) + #:select (invoke/quiet)) #:use-module ((guix utils) #:select (%current-system call-with-temporary-directory)) #:use-module (gnu packages) #:use-module (gnu packages bootstrap) #:use-module (srfi srfi-34) + #:use-module (srfi srfi-35) #:use-module (srfi srfi-64) #:use-module (rnrs io ports) #:use-module (ice-9 popen)) @@ -108,20 +111,39 @@ ;; it can't know about the bootstrap bash in the store, since it's not ;; named "bash". Help it out a bit by providing a symlink it this ;; package's output. - (setenv "PATH" (dirname bash)) - (wrap-program foo `("GUIX_FOO" prefix ("hello"))) - (wrap-program foo `("GUIX_BAR" prefix ("world"))) - - ;; The bootstrap Bash is linked against an old libc and would abort with - ;; an assertion failure when trying to load incompatible locale data. - (unsetenv "LOCPATH") - - (let* ((pipe (open-input-pipe foo)) - (str (get-string-all pipe))) - (with-directory-excursion directory - (for-each delete-file '("foo" ".foo-real"))) - (and (zero? (close-pipe pipe)) - str)))))) + (with-environment-variable "PATH" (dirname bash) + (wrap-program foo `("GUIX_FOO" prefix ("hello"))) + (wrap-program foo `("GUIX_BAR" prefix ("world"))) + + ;; The bootstrap Bash is linked against an old libc and would abort + ;; with an assertion failure when trying to load incompatible locale + ;; data. + (unsetenv "LOCPATH") + + (let* ((pipe (open-input-pipe foo)) + (str (get-string-all pipe))) + (with-directory-excursion directory + (for-each delete-file '("foo" ".foo-real"))) + (and (zero? (close-pipe pipe)) + str))))))) + +(test-assert "invoke/quiet, success" + (begin + (invoke/quiet "true") + #t)) + +(test-assert "invoke/quiet, failure" + (guard (c ((message-condition? c) + (string-contains (condition-message c) "This is an error."))) + (invoke/quiet "sh" "-c" "echo This is an error. ; false") + #f)) + +(test-assert "invoke/quiet, failure, message on stderr" + (guard (c ((message-condition? c) + (string-contains (condition-message c) + "This is another error."))) + (invoke/quiet "sh" "-c" "echo This is another error. >&2 ; false") + #f)) (let ((script-contents "\ #!/anything/cabbage-bash-1.2.3/bin/sh |