civodul pushed a commit to branch master
in repository guix.
commit ee6d2a77a3f07c4b81fd31bc7aa5d07accc317bd
Author: Ludovic Courtès <[email protected]>
AuthorDate: Thu Apr 17 18:44:49 2025 +0200
git: Use ‘graph-descendant?’ from Guile-Git >= 0.10.0 when available.
Fixes <https://issues.guix.gnu.org/66268>.
Fixes a bug whereby ‘commit-relation’ and ‘commit-descendant?’ would
provide an incorrect result when two distinct <commit> objects would
exist for the same commit, which happens when the commit’s metadata is
beyond 4 KiB at least as of libgit2 1.8/1.9.
This, in turn, would lead ‘guix pull’ & co. to wrongfully report an
attempt to downgrade and pull to an unrelated commit.
* guix/git.scm (commit-relation): When (git graph) is available,
rewrite in terms of ‘graph-descendant?’.
(commit-descendant?): Likewise.
Change-Id: Ie52b188a8dfa90c95a73387c3ab2fdd04d2bf3e9
Reported-by: Tomas Volf <[email protected]>
---
guix/git.scm | 85 +++++++++++++++++++++++++++++++++++++-----------------------
1 file changed, 53 insertions(+), 32 deletions(-)
diff --git a/guix/git.scm b/guix/git.scm
index 01e0918588..1065479091 100644
--- a/guix/git.scm
+++ b/guix/git.scm
@@ -732,7 +732,7 @@ Log progress and checkout info to LOG-PORT."
;;; Commit difference.
;;;
-(define* (commit-closure commit #:optional (visited (setq)))
+(define* (commit-closure commit #:optional (visited (setq))) ;to remove
"Return the closure of COMMIT as a set. Skip commits contained in VISITED,
a set, and adjoin VISITED to the result."
(let loop ((commits (list commit))
@@ -768,39 +768,60 @@ that of OLD."
(cons head result)
(set-insert head visited)))))))
-(define (commit-relation old new)
- "Return a symbol denoting the relation between OLD and NEW, two commit
+(define commit-relation
+ (if (resolve-module '(git graph) #:ensure #f) ;Guile-Git >= 0.10.0
+ (lambda (old new)
+ "Return a symbol denoting the relation between OLD and NEW, two commit
objects: 'ancestor (meaning that OLD is an ancestor of NEW), 'descendant, or
'unrelated, or 'self (OLD and NEW are the same commit)."
- (if (eq? old new)
- 'self
- (let ((newest (commit-closure new)))
- (if (set-contains? newest old)
- 'ancestor
- (let* ((seen (list->setq (commit-parents new)))
- (oldest (commit-closure old seen)))
- (if (set-contains? oldest new)
- 'descendant
- 'unrelated))))))
-
-(define (commit-descendant? new old)
- "Return true if NEW is the descendant of one of OLD, a list of commits.
-
-When the expected result is likely #t, this is faster than using
-'commit-relation' since fewer commits need to be traversed."
- (let ((old (list->setq old)))
- (let loop ((commits (list new))
- (visited (setq)))
- (match commits
- (()
- #f)
- (_
- ;; Perform a breadth-first search as this is likely going to
- ;; terminate more quickly than a depth-first search.
- (let ((commits (remove (cut set-contains? visited <>) commits)))
- (or (any (cut set-contains? old <>) commits)
- (loop (append-map commit-parents commits)
- (fold set-insert visited commits)))))))))
+ (let ((repository (commit-owner old))
+ (old (commit-id old))
+ (new (commit-id new)))
+ (cond ((graph-descendant? repository new old)
+ 'ancestor)
+ ((oid=? old new)
+ 'self)
+ ((graph-descendant? repository old new)
+ 'descendant)
+ (else 'unrelated))))
+ (lambda (old new) ;remove when Guile-Git 0.10.0 is widespread
+ (if (eq? old new)
+ 'self
+ (let ((newest (commit-closure new)))
+ (if (set-contains? newest old)
+ 'ancestor
+ (let* ((seen (list->setq (commit-parents new)))
+ (oldest (commit-closure old seen)))
+ (if (set-contains? oldest new)
+ 'descendant
+ 'unrelated))))))))
+
+(define commit-descendant?
+ (if (resolve-module '(git graph) #:ensure #f) ;Guile-Git >= 0.10.0
+ (lambda (new old)
+ "Return true if NEW is the descendant of one of OLD, a list of
+commits."
+ (let ((repository (commit-owner new))
+ (new (commit-id new)))
+ (any (lambda (old)
+ (let ((old (commit-id old)))
+ (or (graph-descendant? repository new old)
+ (oid=? old new))))
+ old)))
+ (lambda (new old) ;remove when Guile-Git 0.10.0 is widespread
+ (let ((old (list->setq old)))
+ (let loop ((commits (list new))
+ (visited (setq)))
+ (match commits
+ (()
+ #f)
+ (_
+ ;; Perform a breadth-first search as this is likely going to
+ ;; terminate more quickly than a depth-first search.
+ (let ((commits (remove (cut set-contains? visited <>) commits)))
+ (or (any (cut set-contains? old <>) commits)
+ (loop (append-map commit-parents commits)
+ (fold set-insert visited commits)))))))))))
;;
