tests: Invoke 'git' with a custom '.gitconfig' and ignore the system config.
Fixes <https://bugs.gnu.org/37679>. Reported by Gábor Boskovits <boskovits@gmail.com>. * guix/tests/git.scm (call-with-environment-variables): New procedure. (with-environment-variables): New macro. (populate-git-repository)[git]: Wrap (git-command) invocation in 'call-with-temporary-directory' and 'with-environment-variables'.
This commit is contained in:
		
							parent
							
								
									0639a24038
								
							
						
					
					
						commit
						3c91f00341
					
				
					 1 changed files with 34 additions and 3 deletions
				
			
		|  | @ -1,5 +1,5 @@ | ||||||
| ;;; GNU Guix --- Functional package management for GNU | ;;; GNU Guix --- Functional package management for GNU | ||||||
| ;;; Copyright © 2019 Ludovic Courtès <ludo@gnu.org> | ;;; Copyright © 2019, 2020 Ludovic Courtès <ludo@gnu.org> | ||||||
| ;;; | ;;; | ||||||
| ;;; This file is part of GNU Guix. | ;;; This file is part of GNU Guix. | ||||||
| ;;; | ;;; | ||||||
|  | @ -30,6 +30,24 @@ | ||||||
| (define git-command | (define git-command | ||||||
|   (make-parameter "git")) |   (make-parameter "git")) | ||||||
| 
 | 
 | ||||||
|  | (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 (populate-git-repository directory directives) | (define (populate-git-repository directory directives) | ||||||
|   "Initialize a new Git checkout and repository in DIRECTORY and apply |   "Initialize a new Git checkout and repository in DIRECTORY and apply | ||||||
| DIRECTIVES.  Each element of DIRECTIVES is an sexp like: | DIRECTIVES.  Each element of DIRECTIVES is an sexp like: | ||||||
|  | @ -41,8 +59,21 @@ Return DIRECTORY on success." | ||||||
|   ;; Note: As of version 0.2.0, Guile-Git lacks the necessary bindings to do |   ;; Note: As of version 0.2.0, Guile-Git lacks the necessary bindings to do | ||||||
|   ;; all this, so resort to the "git" command. |   ;; all this, so resort to the "git" command. | ||||||
|   (define (git command . args) |   (define (git command . args) | ||||||
|  |     ;; Make sure Git doesn't rely on the user's config. | ||||||
|  |     (call-with-temporary-directory | ||||||
|  |      (lambda (home) | ||||||
|  |        (call-with-output-file (string-append home "/.gitconfig") | ||||||
|  |          (lambda (port) | ||||||
|  |            (display "[user] | ||||||
|  |   email = charlie@example.org\n  name = Charlie Guix\n" | ||||||
|  |                     port))) | ||||||
|  | 
 | ||||||
|  |        (with-environment-variables | ||||||
|  |         `(("GIT_CONFIG_NOSYSTEM" "1") | ||||||
|  |           ("GIT_ATTR_NOSYSTEM" "1") | ||||||
|  |           ("HOME" ,home)) | ||||||
|         (apply invoke (git-command) "-C" directory |         (apply invoke (git-command) "-C" directory | ||||||
|            command args)) |                command args))))) | ||||||
| 
 | 
 | ||||||
|   (mkdir-p directory) |   (mkdir-p directory) | ||||||
|   (git "init") |   (git "init") | ||||||
|  |  | ||||||
		Reference in a new issue