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 @@ | |||
|   #:use-module ((guix git) #:select (with-repository)) | ||||
|   #:use-module (guix utils) | ||||
|   #:use-module (guix build utils) | ||||
|   #:use-module ((guix tests gnupg) #:select (with-environment-variables)) | ||||
|   #:use-module (ice-9 match) | ||||
|   #:use-module (ice-9 control) | ||||
|   #:export (git-command | ||||
|  |  | |||
|  | @ -22,27 +22,7 @@ | |||
|   #:use-module (ice-9 match) | ||||
|   #:export (gpg-command | ||||
|             gpgconf-command | ||||
|             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 ...))) | ||||
|             with-fresh-gnupg-setup)) | ||||
| 
 | ||||
| (define gpg-command | ||||
|   (make-parameter "gpg")) | ||||
|  |  | |||
|  | @ -89,7 +89,6 @@ | |||
|             guile-version>? | ||||
|             version-prefix? | ||||
|             string-replace-substring | ||||
|             arguments-from-environment-variable | ||||
|             file-extension | ||||
|             file-sans-extension | ||||
|             tarball-sans-extension | ||||
|  | @ -99,6 +98,9 @@ | |||
|             call-with-temporary-directory | ||||
|             with-atomic-file-output | ||||
| 
 | ||||
|             with-environment-variables | ||||
|             arguments-from-environment-variable | ||||
| 
 | ||||
|             config-directory | ||||
|             cache-directory | ||||
| 
 | ||||
|  | @ -113,6 +115,38 @@ | |||
|             call-with-compressed-output-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. | ||||
|  | @ -582,6 +616,11 @@ minor version numbers from version-string." | |||
|       (list-prefix? (string-tokenize v1 not-dot) | ||||
|                     (string-tokenize v2 not-dot))))) | ||||
| 
 | ||||
|  | ||||
| ;;; | ||||
| ;;; Files. | ||||
| ;;; | ||||
| 
 | ||||
| (define (file-extension file) | ||||
|   "Return the extension of FILE or #f if there is none." | ||||
|   (let ((dot (string-rindex file #\.))) | ||||
|  | @ -634,15 +673,6 @@ REPLACEMENT." | |||
|                        (substring str start index) | ||||
|                        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) | ||||
|   "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 | ||||
|  |  | |||
		Reference in a new issue