summaryrefslogtreecommitdiff
path: root/tests/build-utils.scm
diff options
context:
space:
mode:
Diffstat (limited to 'tests/build-utils.scm')
-rw-r--r--tests/build-utils.scm52
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