git: Remove untracked files from cached checkouts.
Cached checkouts could end up with stale untracked files, for example because the checkout was interrupted. As a result, when this happens for the Guix checkout, users would not get substitutes for ‘guix pull’. * guix/git.scm (delete-untracked-files): New procedure. (switch-to-ref): Use it. * tests/git.scm ("update-cached-checkout, untracked files removed"): New test. Co-authored-by: Ricardo Wurmus <rekado@elephly.net> Change-Id: Iccbe644ade396ad27a037db7e0ef1c2a68ef91cemaster
parent
fcd3c5d3aa
commit
58e268c2e3
24
guix/git.scm
24
guix/git.scm
|
@ -298,6 +298,25 @@ corresponding Git object."
|
||||||
(('tag . tag)
|
(('tag . tag)
|
||||||
(tag->commit repository tag)))))
|
(tag->commit repository tag)))))
|
||||||
|
|
||||||
|
(define (delete-untracked-files repository)
|
||||||
|
"Delete untracked files from the work directory of REPOSITORY."
|
||||||
|
(let ((workdir (repository-working-directory repository))
|
||||||
|
(status (status-list-new repository
|
||||||
|
(make-status-options
|
||||||
|
STATUS-SHOW-WORKDIR-ONLY
|
||||||
|
(logior
|
||||||
|
STATUS-FLAG-INCLUDE-UNTRACKED
|
||||||
|
STATUS-FLAG-INCLUDE-IGNORED)))))
|
||||||
|
(for-each (lambda (entry)
|
||||||
|
(let ((status (status-entry-status entry)))
|
||||||
|
(when (or (memq 'wt-new status)
|
||||||
|
(memq 'ignored status))
|
||||||
|
(let* ((diff (status-entry-index-to-workdir entry))
|
||||||
|
(new (diff-delta-new-file diff)))
|
||||||
|
(delete-file-recursively
|
||||||
|
(in-vicinity workdir (diff-file-path new)))))))
|
||||||
|
(status-list->status-entries status))))
|
||||||
|
|
||||||
(define (switch-to-ref repository ref)
|
(define (switch-to-ref repository ref)
|
||||||
"Switch to REPOSITORY's branch, commit or tag specified by REF. Return the
|
"Switch to REPOSITORY's branch, commit or tag specified by REF. Return the
|
||||||
OID (roughly the commit hash) corresponding to REF."
|
OID (roughly the commit hash) corresponding to REF."
|
||||||
|
@ -305,6 +324,11 @@ OID (roughly the commit hash) corresponding to REF."
|
||||||
(resolve-reference repository ref))
|
(resolve-reference repository ref))
|
||||||
|
|
||||||
(reset repository obj RESET_HARD)
|
(reset repository obj RESET_HARD)
|
||||||
|
|
||||||
|
;; There might still be untracked files in REPOSITORY due to an interrupted
|
||||||
|
;; checkout for example; delete them.
|
||||||
|
(delete-untracked-files repository)
|
||||||
|
|
||||||
(object-id obj))
|
(object-id obj))
|
||||||
|
|
||||||
(define (call-with-repository directory proc)
|
(define (call-with-repository directory proc)
|
||||||
|
|
|
@ -1,5 +1,5 @@
|
||||||
;;; GNU Guix --- Functional package management for GNU
|
;;; GNU Guix --- Functional package management for GNU
|
||||||
;;; Copyright © 2019, 2020, 2022 Ludovic Courtès <ludo@gnu.org>
|
;;; Copyright © 2019-2020, 2022, 2024 Ludovic Courtès <ludo@gnu.org>
|
||||||
;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz
|
;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz
|
||||||
;;;
|
;;;
|
||||||
;;; This file is part of GNU Guix.
|
;;; This file is part of GNU Guix.
|
||||||
|
@ -259,4 +259,24 @@
|
||||||
;; COMMIT should be the ID of the commit object, not that of the tag.
|
;; COMMIT should be the ID of the commit object, not that of the tag.
|
||||||
(string=? commit head))))))
|
(string=? commit head))))))
|
||||||
|
|
||||||
|
(test-assert "update-cached-checkout, untracked files removed"
|
||||||
|
(call-with-temporary-directory
|
||||||
|
(lambda (cache)
|
||||||
|
(with-temporary-git-repository directory
|
||||||
|
'((add "a.txt" "A")
|
||||||
|
(add ".gitignore" ".~\n")
|
||||||
|
(commit "First commit"))
|
||||||
|
(let ((directory commit relation
|
||||||
|
(update-cached-checkout directory
|
||||||
|
#:ref '()
|
||||||
|
#:cache-directory cache)))
|
||||||
|
(close-port
|
||||||
|
(open-output-file (in-vicinity cache "stale-untracked-file")))
|
||||||
|
(let ((directory2 commit2 relation2
|
||||||
|
(update-cached-checkout directory
|
||||||
|
#:ref '()
|
||||||
|
#:cache-directory cache)))
|
||||||
|
(not (file-exists?
|
||||||
|
(in-vicinity cache "stale-untracked-file")))))))))
|
||||||
|
|
||||||
(test-end "git")
|
(test-end "git")
|
||||||
|
|
Reference in New Issue