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'.
This commit is contained in:
parent
0848615300
commit
22f95e028f
|
@ -39,6 +39,8 @@
|
||||||
canonical-file?
|
canonical-file?
|
||||||
network-reachable?
|
network-reachable?
|
||||||
shebang-too-long?
|
shebang-too-long?
|
||||||
|
with-environment-variable
|
||||||
|
|
||||||
mock
|
mock
|
||||||
%test-substitute-urls
|
%test-substitute-urls
|
||||||
test-assertm
|
test-assertm
|
||||||
|
@ -195,6 +197,19 @@ store is opened."
|
||||||
(run-with-store store exp
|
(run-with-store store exp
|
||||||
#:guile-for-build (%guile-for-build)))))
|
#:guile-for-build (%guile-for-build)))))
|
||||||
|
|
||||||
|
(define-syntax-rule (with-environment-variable variable value body ...)
|
||||||
|
"Run BODY with VARIABLE set to VALUE."
|
||||||
|
(let ((orig (getenv variable)))
|
||||||
|
(dynamic-wind
|
||||||
|
(lambda ()
|
||||||
|
(setenv variable value))
|
||||||
|
(lambda ()
|
||||||
|
body ...)
|
||||||
|
(lambda ()
|
||||||
|
(if orig
|
||||||
|
(setenv variable orig)
|
||||||
|
(unsetenv variable))))))
|
||||||
|
|
||||||
|
|
||||||
;;;
|
;;;
|
||||||
;;; Narinfo files, as used by the substituter.
|
;;; Narinfo files, as used by the substituter.
|
||||||
|
|
|
@ -107,19 +107,21 @@
|
||||||
;; it can't know about the bootstrap bash in the store, since it's not
|
;; 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
|
;; named "bash". Help it out a bit by providing a symlink it this
|
||||||
;; package's output.
|
;; package's output.
|
||||||
(setenv "PATH" (dirname bash))
|
(with-environment-variable "PATH" (dirname bash)
|
||||||
(wrap-program foo `("GUIX_FOO" prefix ("hello")))
|
(wrap-program foo `("GUIX_FOO" prefix ("hello")))
|
||||||
(wrap-program foo `("GUIX_BAR" prefix ("world")))
|
(wrap-program foo `("GUIX_BAR" prefix ("world")))
|
||||||
|
|
||||||
;; The bootstrap Bash is linked against an old libc and would abort with
|
;; The bootstrap Bash is linked against an old libc and would abort
|
||||||
;; an assertion failure when trying to load incompatible locale data.
|
;; with an assertion failure when trying to load incompatible locale
|
||||||
(unsetenv "LOCPATH")
|
;; 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)))))))
|
||||||
|
|
||||||
(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-end)
|
(test-end)
|
||||||
|
|
|
@ -1,5 +1,5 @@
|
||||||
;;; GNU Guix --- Functional package management for GNU
|
;;; GNU Guix --- Functional package management for GNU
|
||||||
;;; Copyright © 2015 Ludovic Courtès <ludo@gnu.org>
|
;;; Copyright © 2015, 2019 Ludovic Courtès <ludo@gnu.org>
|
||||||
;;;
|
;;;
|
||||||
;;; This file is part of GNU Guix.
|
;;; This file is part of GNU Guix.
|
||||||
;;;
|
;;;
|
||||||
|
@ -25,19 +25,6 @@
|
||||||
|
|
||||||
;; Test the (guix scripts) module.
|
;; Test the (guix scripts) module.
|
||||||
|
|
||||||
(define-syntax-rule (with-environment-variable variable value body ...)
|
|
||||||
"Run BODY with VARIABLE set to VALUE."
|
|
||||||
(let ((orig (getenv variable)))
|
|
||||||
(dynamic-wind
|
|
||||||
(lambda ()
|
|
||||||
(setenv variable value))
|
|
||||||
(lambda ()
|
|
||||||
body ...)
|
|
||||||
(lambda ()
|
|
||||||
(if orig
|
|
||||||
(setenv variable orig)
|
|
||||||
(unsetenv variable))))))
|
|
||||||
|
|
||||||
|
|
||||||
(test-begin "scripts")
|
(test-begin "scripts")
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue