git: Fix update cached checkout when not a symref.

Follow up of 66463356ce.

* guix/git.scm (update-cached-checkout)[symref?]: New procedure.
[ref->refspecs]: New procedure.
Use them.

Change-Id: Ia2cb7db45222d59d61a2349bec277fd06456844b
Signed-off-by: Ludovic Courtès <ludo@gnu.org>
Modified-by: Ludovic Courtès <ludo@gnu.org>
This commit is contained in:
Simon Tournier 2025-09-25 13:25:44 +02:00 committed by Ludovic Courtès
parent 052fab5f0b
commit 6e12325bf3
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5

View file

@ -5,7 +5,7 @@
;;; Copyright © 2021 Marius Bakke <marius@gnu.org> ;;; Copyright © 2021 Marius Bakke <marius@gnu.org>
;;; Copyright © 2022 Maxime Devos <maximedevos@telenet.be> ;;; Copyright © 2022 Maxime Devos <maximedevos@telenet.be>
;;; Copyright © 2023 Tobias Geerinckx-Rice <me@tobias.gr> ;;; Copyright © 2023 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2023 Simon Tournier <zimon.toutoune@gmail.com> ;;; Copyright © 2023, 2025 Simon Tournier <zimon.toutoune@gmail.com>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -575,10 +575,16 @@ current settings unchanged."
(string-append "origin/" branch)))) (string-append "origin/" branch))))
(_ ref))) (_ ref)))
(define symref-list (define symref?
(match ref (match-lambda
(('symref . symref) (list symref)) (('symref . _) #t)
(_ '()))) (_ #f)))
(define ref->refspecs
(match-lambda
(('symref . symref)
(list (string-append "+" symref ":" symref)))
(_ '())))
(with-libgit2 (with-libgit2
(set-git-timeouts connection-timeout read-timeout) (set-git-timeouts connection-timeout read-timeout)
@ -595,7 +601,7 @@ current settings unchanged."
;; When using symrefs, fetch remote again even if it has been cloned just ;; When using symrefs, fetch remote again even if it has been cloned just
;; before as the requested reference are not fetched when cloning. ;; before as the requested reference are not fetched when cloning.
(when (and cache-exists? (when (and (or cache-exists? (symref? ref))
(not (reference-available? repository ref))) (not (reference-available? repository ref)))
(remote-fetch (remote-lookup repository "origin") (remote-fetch (remote-lookup repository "origin")
#:fetch-options (make-default-fetch-options #:fetch-options (make-default-fetch-options
@ -603,9 +609,7 @@ current settings unchanged."
verify-certificate?) verify-certificate?)
;; Build refspecs from symbolic references so they are ;; Build refspecs from symbolic references so they are
;; created locally and updated if necessary. ;; created locally and updated if necessary.
#:refspecs (map (lambda (ref) #:refspecs (ref->refspecs ref)))
(string-append "+" ref ":" ref))
symref-list)))
(when recursive? (when recursive?
(update-submodules repository #:log-port log-port (update-submodules repository #:log-port log-port
#:fetch-options #:fetch-options