1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
|
;;; Guile-Git --- GNU Guile bindings of libgit2
;;; Copyright © 2021 Julien Lepiller <julien@lepiller.eu>
;;; Copyright © 2021, 2024 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of Guile-Git.
;;;
;;; Guile-Git is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or
;;; (at your option) any later version.
;;;
;;; Guile-Git is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;;; General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with Guile-Git. If not, see <http://www.gnu.org/licenses/>.
(define-module (tests config)
#:use-module (git)
#:use-module (git configuration)
#:use-module (tests helpers)
#:use-module (srfi srfi-64))
(test-begin "config")
(libgit2-init!)
(with-repository "simple-bare" directory
(test-equal "config entry get"
"true"
(let* ((repository (repository-open directory))
(config (repository-config repository))
(entry (config-get-entry config "core.bare")))
(config-entry-value entry)))
(test-equal "config entry get, nonexistent"
GIT_ENOTFOUND
(catch 'git-error
(lambda ()
(let* ((repository (repository-open directory))
(config (repository-config repository)))
(config-get-entry config "something.that.does-not-exist")))
(lambda (key error . rest)
(git-error-code error))))
(test-equal "config entry"
"true"
(let* ((repository (repository-open directory))
(config (repository-config repository))
(bare #f))
(config-foreach config (lambda (entry)
(when (equal? (config-entry-name entry) "core.bare")
(set! bare (config-entry-value entry)))
0))
bare))
(test-equal "config entry fold"
"true"
(let* ((repository (repository-open directory))
(config (repository-config repository)))
(config-fold (lambda (entry out)
(gc)
(format #t "~a~%" entry)
(if (equal? (config-entry-name entry) "core.bare")
(config-entry-value entry)
out))
#f config)))
(test-assert "config entry fold, capture entries"
;; Purposefully capture the <config-entry> record passed by 'config-fold'
;; and make sure we can access them after 'config-fold' has returned.
(let* ((repository (repository-open directory))
(config (repository-config repository))
(entries (config-fold cons '() config))
(keys '("core.bare" "core.filemode"
"core.repositoryformatversion")))
(gc)
;; Since ~/.gitconfig can add arbitrary entries, only look at KEYS.
(equal? (sort (filter (lambda (name)
(member name keys))
(map config-entry-name entries))
string<?)
keys)))
(test-equal "set-config-string & co."
`("Hello, world." "42" ,(number->string (expt 2 42)) "false")
(let* ((repository (repository-open directory))
(config (repository-config repository)))
(and (not (false-if-exception (config-get-entry config "guix.test.string")))
(begin
(set-config-string config "guix.test.string" "Hello, world.")
(set-config-integer config "guix.test.int32" 42)
(set-config-integer config "guix.test.int64" (expt 2 42))
(set-config-boolean config "guix.test.boolean" #f)
(repository-close! repository)
(let ((repository (repository-open directory))
(config (repository-config repository)))
(system* "cat" (string-append directory "/config"))
(map (lambda (key)
(config-entry-value (config-get-entry config key)))
'("guix.test.string"
"guix.test.int32"
"guix.test.int64"
"guix.test.boolean")))))))
(unless %have-config-entry-backend-type? (test-skip 1))
(test-equal "backend-type & origin-path"
(list 'file
(canonicalize-path (in-vicinity directory "config")))
(let* ((repository (repository-open directory))
(config (repository-config repository))
(entry (config-get-entry config "guix.test.string"))
(type (config-entry-backend-type entry))
(path (config-entry-origin-path entry)))
(repository-close! repository)
(list type path))))
(libgit2-shutdown!)
(test-end)
|
