amaharaneko/guix-mirrors
1
1
Fork 0
mirror of https://codeberg.org/guix/guix.git synced 2025-10-02 02:15:12 +00:00
Code Issues Projects Releases Packages Wiki Activity Actions

git: Use ‘graph-descendant?’ from Guile-Git >= 0.10.0 when available.

Browse source 
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 <~@wolfsden.cz>
This commit is contained in:
Ludovic Courtès 2025-04-17 18:44:49 +02:00
parent 27e62d4481
commit ee6d2a77a3
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
1 changed files with 52 additions and 31 deletions
Download patch file Download diff file Expand all files Collapse all files

83
guix/git.scm
View file

@ -732,7 +732,7 @@ Log progress and checkout info to LOG-PORT."
;;; Commit difference. ;;; 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, "Return the closure of COMMIT as a set. Skip commits contained in VISITED,
a set, and adjoin VISITED to the result." a set, and adjoin VISITED to the result."
(let loop ((commits (list commit)) (let loop ((commits (list commit))
@ -768,39 +768,60 @@ that of OLD."
(cons head result) (cons head result)
(set-insert head visited))))))) (set-insert head visited)))))))
(define (commit-relation old new) (define commit-relation
"Return a symbol denoting the relation between OLD and NEW, two commit (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 objects: 'ancestor (meaning that OLD is an ancestor of NEW), 'descendant, or
'unrelated, or 'self (OLD and NEW are the same commit)." 'unrelated, or 'self (OLD and NEW are the same commit)."
(if (eq? old new) (let ((repository (commit-owner old))
'self (old (commit-id old))
(let ((newest (commit-closure new))) (new (commit-id new)))
(if (set-contains? newest old) (cond ((graph-descendant? repository new old)
'ancestor 'ancestor)
(let* ((seen (list->setq (commit-parents new))) ((oid=? old new)
(oldest (commit-closure old seen))) 'self)
(if (set-contains? oldest new) ((graph-descendant? repository old new)
'descendant 'descendant)
'unrelated)))))) (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? new old) (define commit-descendant?
"Return true if NEW is the descendant of one of OLD, a list of commits. (if (resolve-module '(git graph) #:ensure #f) ;Guile-Git >= 0.10.0
(lambda (new old)
When the expected result is likely #t, this is faster than using "Return true if NEW is the descendant of one of OLD, a list of
'commit-relation' since fewer commits need to be traversed." commits."
(let ((old (list->setq old))) (let ((repository (commit-owner new))
(let loop ((commits (list new)) (new (commit-id new)))
(visited (setq))) (any (lambda (old)
(match commits (let ((old (commit-id old)))
(() (or (graph-descendant? repository new old)
#f) (oid=? old new))))
(_ old)))
;; Perform a breadth-first search as this is likely going to (lambda (new old) ;remove when Guile-Git 0.10.0 is widespread
;; terminate more quickly than a depth-first search. (let ((old (list->setq old)))
(let ((commits (remove (cut set-contains? visited <>) commits))) (let loop ((commits (list new))
(or (any (cut set-contains? old <>) commits) (visited (setq)))
(loop (append-map commit-parents commits) (match commits
(fold set-insert visited 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)))))))))))
;; ;;