utils: Add 'with-environment-variables'.

* guix/tests/gnupg.scm (call-with-environment-variables)
(with-environment-variables): Move to...
* guix/utils.scm: ... here.
* guix/tests/git.scm: Adjust accordingly.
This commit is contained in:
Ludovic Courtès 2020-06-06 23:00:05 +02:00
parent b2ee53d5ae
commit d67a881966
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
3 changed files with 41 additions and 32 deletions

@ -21,7 +21,6 @@
#:use-module ((guix git) #:select (with-repository)) #:use-module ((guix git) #:select (with-repository))
#:use-module (guix utils) #:use-module (guix utils)
#:use-module (guix build utils) #:use-module (guix build utils)
#:use-module ((guix tests gnupg) #:select (with-environment-variables))
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:use-module (ice-9 control) #:use-module (ice-9 control)
#:export (git-command #:export (git-command

@ -22,27 +22,7 @@
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:export (gpg-command #:export (gpg-command
gpgconf-command gpgconf-command
with-fresh-gnupg-setup with-fresh-gnupg-setup))
with-environment-variables))
(define (call-with-environment-variables variables thunk)
"Call THUNK with the environment VARIABLES set."
(let ((environment (environ)))
(dynamic-wind
(lambda ()
(for-each (match-lambda
((variable value)
(setenv variable value)))
variables))
thunk
(lambda ()
(environ environment)))))
(define-syntax-rule (with-environment-variables variables exp ...)
"Evaluate EXP with the given environment VARIABLES set."
(call-with-environment-variables variables
(lambda () exp ...)))
(define gpg-command (define gpg-command
(make-parameter "gpg")) (make-parameter "gpg"))

@ -89,7 +89,6 @@
guile-version>? guile-version>?
version-prefix? version-prefix?
string-replace-substring string-replace-substring
arguments-from-environment-variable
file-extension file-extension
file-sans-extension file-sans-extension
tarball-sans-extension tarball-sans-extension
@ -99,6 +98,9 @@
call-with-temporary-directory call-with-temporary-directory
with-atomic-file-output with-atomic-file-output
with-environment-variables
arguments-from-environment-variable
config-directory config-directory
cache-directory cache-directory
@ -113,6 +115,38 @@
call-with-compressed-output-port call-with-compressed-output-port
canonical-newline-port)) canonical-newline-port))
;;;
;;; Environment variables.
;;;
(define (call-with-environment-variables variables thunk)
"Call THUNK with the environment VARIABLES set."
(let ((environment (environ)))
(dynamic-wind
(lambda ()
(for-each (match-lambda
((variable value)
(setenv variable value)))
variables))
thunk
(lambda ()
(environ environment)))))
(define-syntax-rule (with-environment-variables variables exp ...)
"Evaluate EXP with the given environment VARIABLES set."
(call-with-environment-variables variables
(lambda () exp ...)))
(define (arguments-from-environment-variable variable)
"Retrieve value of environment variable denoted by string VARIABLE in the
form of a list of strings (`char-set:graphic' tokens) suitable for consumption
by `args-fold', if VARIABLE is defined, otherwise return an empty list."
(let ((env (getenv variable)))
(if env
(string-tokenize env char-set:graphic)
'())))
;;; ;;;
;;; Filtering & pipes. ;;; Filtering & pipes.
@ -582,6 +616,11 @@ minor version numbers from version-string."
(list-prefix? (string-tokenize v1 not-dot) (list-prefix? (string-tokenize v1 not-dot)
(string-tokenize v2 not-dot))))) (string-tokenize v2 not-dot)))))
;;;
;;; Files.
;;;
(define (file-extension file) (define (file-extension file)
"Return the extension of FILE or #f if there is none." "Return the extension of FILE or #f if there is none."
(let ((dot (string-rindex file #\.))) (let ((dot (string-rindex file #\.)))
@ -634,15 +673,6 @@ REPLACEMENT."
(substring str start index) (substring str start index)
pieces)))))))) pieces))))))))
(define (arguments-from-environment-variable variable)
"Retrieve value of environment variable denoted by string VARIABLE in the
form of a list of strings (`char-set:graphic' tokens) suitable for consumption
by `args-fold', if VARIABLE is defined, otherwise return an empty list."
(let ((env (getenv variable)))
(if env
(string-tokenize env char-set:graphic)
'())))
(define (call-with-temporary-output-file proc) (define (call-with-temporary-output-file proc)
"Call PROC with a name of a temporary file and open output port to that "Call PROC with a name of a temporary file and open output port to that
file; close the file and delete it when leaving the dynamic extent of this file; close the file and delete it when leaving the dynamic extent of this