git: 'update-cached-checkout' returns the commit relation.

* guix/git.scm (update-cached-checkout): Add #:starting-commit
parameter.  Call 'commit-relation' when #:starting-commit is true.
Always return the relation or #f as the third value.
(latest-repository-commit): Adjust accordingly.
* guix/import/opam.scm (get-opam-repository): Likewise.
* tests/channels.scm ("latest-channel-instances includes channel dependencies")
("latest-channel-instances excludes duplicate channel dependencies"):
Update mock of 'update-cached-checkout' accordingly.
This commit is contained in:
Ludovic Courtès 2020-05-20 17:57:54 +02:00
parent 9b049de84e
commit 8d1d56578a
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
4 changed files with 25 additions and 13 deletions

View File

@ -218,7 +218,7 @@ result is unspecified."
(and (string=? (basename file) ".git") (and (string=? (basename file) ".git")
(eq? 'directory (stat:type stat)))) (eq? 'directory (stat:type stat))))
(let-values (((checkout commit) (let-values (((checkout commit relation)
(update-cached-checkout (channel-url channel) (update-cached-checkout (channel-url channel)
#:ref (channel-reference channel)))) #:ref (channel-reference channel))))
(when (guix-channel? channel) (when (guix-channel? channel)

View File

@ -262,14 +262,16 @@ definitely available in REPOSITORY, false otherwise."
#:key #:key
(ref '(branch . "master")) (ref '(branch . "master"))
recursive? recursive?
starting-commit
(log-port (%make-void-port "w")) (log-port (%make-void-port "w"))
(cache-directory (cache-directory
(url-cache-directory (url-cache-directory
url (%repository-cache-directory) url (%repository-cache-directory)
#:recursive? recursive?))) #:recursive? recursive?)))
"Update the cached checkout of URL to REF in CACHE-DIRECTORY. Return two "Update the cached checkout of URL to REF in CACHE-DIRECTORY. Return three
values: the cache directory name, and the SHA1 commit (a string) corresponding values: the cache directory name, and the SHA1 commit (a string) corresponding
to REF. to REF, and the relation of the new commit relative to STARTING-COMMIT (if
provided) as returned by 'commit-relation'.
REF is pair whose key is [branch | commit | tag | tag-or-commit ] and value REF is pair whose key is [branch | commit | tag | tag-or-commit ] and value
the associated data: [<branch name> | <sha1> | <tag name> | <string>]. the associated data: [<branch name> | <sha1> | <tag name> | <string>].
@ -302,7 +304,17 @@ When RECURSIVE? is true, check out submodules as well, if any."
(remote-fetch (remote-lookup repository "origin")))) (remote-fetch (remote-lookup repository "origin"))))
(when recursive? (when recursive?
(update-submodules repository #:log-port log-port)) (update-submodules repository #:log-port log-port))
(let ((oid (switch-to-ref repository canonical-ref)))
;; Note: call 'commit-relation' from here because it's more efficient
;; than letting users re-open the checkout later on.
(let* ((oid (switch-to-ref repository canonical-ref))
(new (and starting-commit
(commit-lookup repository oid)))
(old (and starting-commit
(commit-lookup repository
(string->oid starting-commit))))
(relation (and starting-commit
(commit-relation old new))))
;; Reclaim file descriptors and memory mappings associated with ;; Reclaim file descriptors and memory mappings associated with
;; REPOSITORY as soon as possible. ;; REPOSITORY as soon as possible.
@ -310,7 +322,7 @@ When RECURSIVE? is true, check out submodules as well, if any."
'repository-close!) 'repository-close!)
(repository-close! repository)) (repository-close! repository))
(values cache-directory (oid->string oid)))))) (values cache-directory (oid->string oid) relation)))))
(define* (latest-repository-commit store url (define* (latest-repository-commit store url
#:key #:key
@ -343,7 +355,7 @@ Log progress and checkout info to LOG-PORT."
(format log-port "updating checkout of '~a'...~%" url) (format log-port "updating checkout of '~a'...~%" url)
(let*-values (let*-values
(((checkout commit) (((checkout commit _)
(update-cached-checkout url (update-cached-checkout url
#:recursive? recursive? #:recursive? recursive?
#:ref ref #:ref ref

View File

@ -115,7 +115,7 @@
(define (get-opam-repository) (define (get-opam-repository)
"Update or fetch the latest version of the opam repository and return the "Update or fetch the latest version of the opam repository and return the
path to the repository." path to the repository."
(receive (location commit) (receive (location commit _)
(update-cached-checkout "https://github.com/ocaml/opam-repository") (update-cached-checkout "https://github.com/ocaml/opam-repository")
location)) location))

View File

@ -136,11 +136,11 @@
(url "test"))) (url "test")))
(test-dir (channel-instance-checkout instance--simple))) (test-dir (channel-instance-checkout instance--simple)))
(mock ((guix git) update-cached-checkout (mock ((guix git) update-cached-checkout
(lambda* (url #:key ref) (lambda* (url #:key ref starting-commit)
(match url (match url
("test" (values test-dir "caf3cabba9e")) ("test" (values test-dir "caf3cabba9e" #f))
(_ (values (channel-instance-checkout instance--no-deps) (_ (values (channel-instance-checkout instance--no-deps)
"abcde1234"))))) "abcde1234" #f)))))
(with-store store (with-store store
(let ((instances (latest-channel-instances store (list channel)))) (let ((instances (latest-channel-instances store (list channel))))
(and (eq? 2 (length instances)) (and (eq? 2 (length instances))
@ -155,11 +155,11 @@
(url "test"))) (url "test")))
(test-dir (channel-instance-checkout instance--with-dupes))) (test-dir (channel-instance-checkout instance--with-dupes)))
(mock ((guix git) update-cached-checkout (mock ((guix git) update-cached-checkout
(lambda* (url #:key ref) (lambda* (url #:key ref starting-commit)
(match url (match url
("test" (values test-dir "caf3cabba9e")) ("test" (values test-dir "caf3cabba9e" #f))
(_ (values (channel-instance-checkout instance--no-deps) (_ (values (channel-instance-checkout instance--no-deps)
"abcde1234"))))) "abcde1234" #f)))))
(with-store store (with-store store
(let ((instances (latest-channel-instances store (list channel)))) (let ((instances (latest-channel-instances store (list channel))))
(and (= 2 (length instances)) (and (= 2 (length instances))