nixo
/
guix-devel
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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:
Ludovic Courtès 2019-03-16 15:11:29 +01:00
parent 0848615300
commit 22f95e028f
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
3 changed files with 30 additions and 26 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
guix/tests.scm
View File

@ -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.

10
tests/build-utils.scm
View File

@ -107,12 +107,13 @@
;; 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
;; data.
(unsetenv "LOCPATH") (unsetenv "LOCPATH")
(let* ((pipe (open-input-pipe foo)) (let* ((pipe (open-input-pipe foo))
@ -120,6 +121,7 @@
(with-directory-excursion directory (with-directory-excursion directory
(for-each delete-file '("foo" ".foo-real"))) (for-each delete-file '("foo" ".foo-real")))
(and (zero? (close-pipe pipe)) (and (zero? (close-pipe pipe))
str)))))) str)))))))
(test-end) (test-end)

15
tests/scripts.scm
View File

@ -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")