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)
|
||||||
(apply invoke (git-command) "-C" directory
|
;; Make sure Git doesn't rely on the user's config.
|
||||||
command args))
|
(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
|
||||||
|
command args)))))
|
||||||
|
|
||||||
(mkdir-p directory)
|
(mkdir-p directory)
|
||||||
(git "init")
|
(git "init")
|
||||||
|
|
Reference in a new issue