summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2019-03-16 15:11:29 +0100
committerLudovic Courtès <ludo@gnu.org>2019-03-16 18:15:09 +0100
commit22f95e028f038cee342f455dfc55bd32b804907c (patch)
treedade133425c4c41f26ffad0ecad315923db94dee
parent0848615300ec0693b2849e80103a13063fa4b190 (diff)
tests: Add 'with-environment-variable'.
* tests/scripts.scm (with-environment-variable): Move to... * guix/tests.scm (with-environment-variable): ... here. * tests/build-utils.scm ("wrap-program, one input, multiple calls"): Use it instead of 'setenv'.
-rw-r--r--guix/tests.scm15
-rw-r--r--tests/build-utils.scm30
-rw-r--r--tests/scripts.scm15
3 files changed, 32 insertions, 28 deletions
diff --git a/guix/tests.scm b/guix/tests.scm
index 749a4edd7ab..35ebf8464d6 100644
--- a/guix/tests.scm
+++ b/guix/tests.scm
@@ -39,6 +39,8 @@
39 canonical-file? 39 canonical-file?
40 network-reachable? 40 network-reachable?
41 shebang-too-long? 41 shebang-too-long?
42 with-environment-variable
43
42 mock 44 mock
43 %test-substitute-urls 45 %test-substitute-urls
44 test-assertm 46 test-assertm
@@ -195,6 +197,19 @@ store is opened."
195 (run-with-store store exp 197 (run-with-store store exp
196 #:guile-for-build (%guile-for-build))))) 198 #:guile-for-build (%guile-for-build)))))
197 199
200(define-syntax-rule (with-environment-variable variable value body ...)
201 "Run BODY with VARIABLE set to VALUE."
202 (let ((orig (getenv variable)))
203 (dynamic-wind
204 (lambda ()
205 (setenv variable value))
206 (lambda ()
207 body ...)
208 (lambda ()
209 (if orig
210 (setenv variable orig)
211 (unsetenv variable))))))
212
198 213
199;;; 214;;;
200;;; Narinfo files, as used by the substituter. 215;;; Narinfo files, as used by the substituter.
diff --git a/tests/build-utils.scm b/tests/build-utils.scm
index 7d49446f666..03216f9a35d 100644
--- a/tests/build-utils.scm
+++ b/tests/build-utils.scm
@@ -107,19 +107,21 @@
107 ;; it can't know about the bootstrap bash in the store, since it's not 107 ;; it can't know about the bootstrap bash in the store, since it's not
108 ;; named "bash". Help it out a bit by providing a symlink it this 108 ;; named "bash". Help it out a bit by providing a symlink it this
109 ;; package's output. 109 ;; package's output.
110 (setenv "PATH" (dirname bash)) 110 (with-environment-variable "PATH" (dirname bash)
111 (wrap-program foo `("GUIX_FOO" prefix ("hello"))) 111 (wrap-program foo `("GUIX_FOO" prefix ("hello")))
112 (wrap-program foo `("GUIX_BAR" prefix ("world"))) 112 (wrap-program foo `("GUIX_BAR" prefix ("world")))
113 113
114 ;; The bootstrap Bash is linked against an old libc and would abort with 114 ;; The bootstrap Bash is linked against an old libc and would abort
115 ;; an assertion failure when trying to load incompatible locale data. 115 ;; with an assertion failure when trying to load incompatible locale
116 (unsetenv "LOCPATH") 116 ;; data.
117 117 (unsetenv "LOCPATH")
118 (let* ((pipe (open-input-pipe foo)) 118
119 (str (get-string-all pipe))) 119 (let* ((pipe (open-input-pipe foo))
120 (with-directory-excursion directory 120 (str (get-string-all pipe)))
121 (for-each delete-file '("foo" ".foo-real"))) 121 (with-directory-excursion directory
122 (and (zero? (close-pipe pipe)) 122 (for-each delete-file '("foo" ".foo-real")))
123 str)))))) 123 (and (zero? (close-pipe pipe))
124 str)))))))
125
124 126
125(test-end) 127(test-end)
diff --git a/tests/scripts.scm b/tests/scripts.scm
index 39017109533..efee271197f 100644
--- a/tests/scripts.scm
+++ b/tests/scripts.scm
@@ -1,5 +1,5 @@
1;;; GNU Guix --- Functional package management for GNU 1;;; GNU Guix --- Functional package management for GNU
2;;; Copyright © 2015 Ludovic Courtès <ludo@gnu.org> 2;;; Copyright © 2015, 2019 Ludovic Courtès <ludo@gnu.org>
3;;; 3;;;
4;;; This file is part of GNU Guix. 4;;; This file is part of GNU Guix.
5;;; 5;;;
@@ -25,19 +25,6 @@
25 25
26;; Test the (guix scripts) module. 26;; Test the (guix scripts) module.
27 27
28(define-syntax-rule (with-environment-variable variable value body ...)
29 "Run BODY with VARIABLE set to VALUE."
30 (let ((orig (getenv variable)))
31 (dynamic-wind
32 (lambda ()
33 (setenv variable value))
34 (lambda ()
35 body ...)
36 (lambda ()
37 (if orig
38 (setenv variable orig)
39 (unsetenv variable))))))
40
41 28
42(test-begin "scripts") 29(test-begin "scripts")
43 30