mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-11-07 07:26:13 -05:00
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:
parent
b2ee53d5ae
commit
d67a881966
3 changed files with 41 additions and 32 deletions
|
@ -21,7 +21,6 @@ (define-module (guix tests git)
|
||||||
#: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 @@ (define-module (guix tests gnupg)
|
||||||
#: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 @@ (define-module (guix utils)
|
||||||
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 @@ (define-module (guix utils)
|
||||||
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 @@ (define-module (guix utils)
|
||||||
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 @@ (define (list-prefix? lst1 lst2)
|
||||||
(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 @@ (define* (string-replace-substring str substr 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
|
||||||
|
|
Loading…
Reference in a new issue