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
125
126
127
128
129
130
131
132
133
134
135
136
137
|
;;; Guile-Git --- GNU Guile bindings of libgit2
;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
;;; Copyright © 2017 Erik Edrosa <erik.edrosa@gmail.com>
;;; Copyright © 2017, 2021, 2024 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2022 Maxime Devos <maximedevos@telenet.be>
;;;
;;; 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 remote)
#:use-module (srfi srfi-64)
#:use-module (ice-9 match))
(use-modules (tests helpers))
(use-modules (git)
(git object))
(test-begin "remote")
(libgit2-init!)
(with-repository "simple-bare" directory
(test-equal "remote lookup & name"
"origin"
(let* ((repository (repository-open directory))
(remote (remote-lookup repository "origin")))
(remote-name remote)))
(test-equal "remote lookup, not found"
(list GIT_ENOTFOUND GITERR_CONFIG)
(catch 'git-error
(lambda ()
(let ((repository (repository-open directory)))
(clear-git-error!)
(remote-lookup repository "does-not-exist")))
(lambda (key err)
(list (git-error-code err) (git-error-class err)))))
(test-equal "remote-url"
;; This is the "origin" remote in 'data/simple-bare.tgz'.
"/home/erik/Workspace/guile-git/tests/data/simple"
(let* ((repository (repository-open directory))
(remote (remote-lookup repository "origin")))
(remote-url remote)))
(test-equal "remote-set-url!"
"https://example.org"
(let ((repository (repository-open directory)))
(remote-set-url! repository "origin" "https://example.org")
(remote-url (remote-lookup repository "origin"))))
(test-equal "remote-default-branch"
"refs/heads/master"
(let* ((repository (repository-open directory))
(remote (remote-lookup repository "origin")))
(remote-set-url! repository "origin"
(string-append "file://"
(canonicalize-path directory)))
(let ((remote (remote-lookup repository "origin")))
(remote-connect remote)
(let ((branch (remote-default-branch remote)))
(remote-disconnect remote)
branch))))
(test-equal "remote-ls (detached)"
'((0 "3f848a1a52416ac99a5c5bf2e6bd55eb7b99d55b"
"0000000000000000000000000000000000000000"
"HEAD")
(0 "3f848a1a52416ac99a5c5bf2e6bd55eb7b99d55b"
"0000000000000000000000000000000000000000"
"refs/heads/master"))
(let ((remote (remote-create-detached directory)))
(remote-connect/detached remote)
;; Order is unimportant(?), so sort the results.
(sort (map (lambda (remote-head)
(list (remote-head-local remote-head)
(oid->string (remote-head-oid remote-head))
(oid->string (remote-head-loid remote-head))
(remote-head-name remote-head)))
(remote-ls remote))
(lambda (x y)
(string<? (list-ref x 3) (list-ref y 3)))))))
(with-repository "simple" remote-directory
(let* ((git-directory (string-append (canonicalize-path remote-directory)
"/.git/"))
(pull-base "refs/pull")
(symref "refs/pull/1")
;; Some commit in the remote.
(symref-commit "b70d89182da3b2019c3fd6755c794ee65921b4a8")
(expected-result (list GIT_ENOTFOUND
GITERR_ODB
symref-commit)))
(mkdir (string-append git-directory
pull-base))
;; Create a symbolic reference in the remote.
(call-with-output-file (string-append git-directory
symref)
(lambda (port)
(display symref-commit port)))
;; Actual test.
(test-equal "remote-fetch with refspecs"
expected-result
(let* ((repository (repository-init (tmpnam))) ; Start with an empty repository.
(oid (string->oid symref-commit))
(error (catch 'git-error
(lambda ()
(object-lookup repository oid))
(lambda (key err)
(list (git-error-code err)
(git-error-class err)))))
(remote (remote-create-anonymous repository
(string-append "file://"
(canonicalize-path remote-directory)))))
(remote-fetch remote #:refspecs (list symref))
(object-lookup repository oid)
(append error
(list
(oid->string
(object-id (object-lookup repository oid)))))))))
(libgit2-shutdown!)
(test-end)
|
